Hücre Değeri 1 ise üste 2 satır ekleme

[Feylosof]

İyi akşamlar diliyorum arkadaşlar.

A Sütununda kaç satırda "1" rakamı varsa o satırların üstüne iki satır ekleme istiyorum. Bunun için kod yazmada yardımcı olur musunuz?

 

[tukayf]

Sub SatirEkle()
    Dim ws As Worksheet
    Dim i As Long
    Dim sonSatir As Long
    
      Set ws = ActiveSheet
        sonSatir = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    For i = sonSatir To 1 Step -1
        If ws.Cells(i, "A").Value = 1 Then
           ws.Rows(i).Resize(2).Insert Shift:=xlDown
        End If
    Next i
End Sub

doğru anladıysam bi dener misiniz.

 

[Feylosof]

Sayın @tukayf çok teşekkür ederim.