hücre değerine göre makro ile 2 satır eklemek

[tubatpbs]

Merhaba,

Ekteki dosyadaki genişlik sütunundaki değerler değiştiğinde 2 tane satır eklemek istiyorum. yani d sütunundaki genişlik değerleri d1=100 d2=100 d3=100 d4=150 ise d3 ten sonra 2 tane satır ekletmek istiyorum.bunu tüm sayfa için yapmam lazım. bunu yapabilecek bir makro hakkında bana yardımcı olabilir misiniz? ekteki dosyada ilk bikaç tanesi için ben manuel olarak ekledim. bu dosya elimdekinin sadece bir kısmı o yüzden bir makroya ihtiyacım var.

 

[tubatpbs]

kimse yardımcı olamayacak mı

 

[tubatpbs]

şöyle bir şey deniyorum ama bi yerde hata yapıyorum..

Sub deneme()
For x = [A100].End(3).Row To 2 Step -1

If Cells(x, "A") = "x+1" Then x = x + 1
ElseIf Rows(x).Insert Then
Next

End If

End Sub

 

[antonio]

Sub satir_ekle()
Dim ss As Integer
Application.ScreenUpdating = False
ss = ThisWorkbook.Sheets(1).Range("D" & Rows.Count).End(3).Row
For i = ss To 2 Step -1
    If Cells(i, 4).Value = "" Then Cells(i, 4).EntireRow.Delete
Next i
Application.ScreenUpdating = True
ss = ThisWorkbook.Sheets(1).Range("D" & Rows.Count).End(3).Row
Application.ScreenUpdating = False

Do
deg = Cells(ss, 4).Value
If Cells(ss - 1, 4).Value = deg And Cells(ss - 1, 4).Value <> "" Then
    ss = ss - 1
    Else
    Rows(ss).Insert shift:=xlUp
    Rows(ss).Insert shift:=xlUp
    ss = ss - 1
End If
Loop While ss > 1
Application.ScreenUpdating = True
End Sub

 

[tubatpbs]

çok teşekkür ederim antonio kod gayet güzel çalışıyor.