Formül sonucuna göre satır ekleyebilirmiyim??

[esmakaraman]

Günaydın arkadaşlar ; Bir döngü oluşturdum bu döngü içersinde satır arasındaki rakam farkları 1'den büyük ise büyük olan rakam kadar satır ekletmem gerekiyor .Aşağıdaki gibi deniyorum ama bir satır ekliyor.yardımıcı olurmusunuz?


Set s1 = ThisWorkbook.Sheets("Sayfa1")
Sat = s1.Cells(65536, 1).End(xlUp).Row

For f = s1.Cells(Sat, 1) To 1 Step -1
h = s1.Cells(f + 1, 1) - s1.Cells(f, 1)
If h > 1 Then
s1.Cells(f, 1).Rows(h).EntireRow.Insert


End If
Next

 

[Necdet]

Merhaba,

Sub SatirEkle()
Dim s1 As Worksheet
Dim i  As Long
Dim j  As Integer
Set s1 = Sheets("Sayfa1")
s1.Select
For i = [A65536].End(3).Row To 3 Step -1
    j = Cells(i, 1) - Cells(i - 1, 1)
    If j > 1 Then
        Rows(i & ":" & i + j - 1).Insert Shift:=xlDown
    End If
Next i
End Sub

 

[esmakaraman]

Teşekkür ederim Necdet bey sayenizde çözüme ulaştım