Koşullu Satır Ekleme

[steppe]

Merhaba Arkadaşlar,
A sütununda yüzlerce veri olduğu için işin içinden çıkamadım.
sıralama
Tarih
isim
isim
şeklinde Yalnız bazen tarihin altında 2 isim değilde 3 isim var.Onun için tarihin altında 2 isim varsa altına boş satır ekleyip boş satıra x yazdırmak istiyorum.Tarihin altında 3 isim varsa satır eklenmeyecek.
Yardımlarınız için şimdiden teşekkür ederim.

 

[çıtır]

Deneyiniz.

Sub satırekle()
Dim s1 As Worksheet: Dim i As Integer
Set s1 = Sheets("Sayfa1")
son = WorksheetFunction.Count(s1.Range("A:A")) * 4
For i = 1 To son Step (4)
If WorksheetFunction.IsText(s1.Cells(i, 1)) Or  s1.Cells(i, 1) = ""  Then
s1.Cells(i - 1, 1).Select
Selection.Insert Shift:=xlDown
ActiveCell.Value = "X"
End If
Next i
End Sub

 

[steppe]

çıtır Hocam,
Yardımlarınız için çok teşekkür ederim.

 

[çıtır]

çıtır Hocam,
Yardımlarınız için çok teşekkür ederim.

Rica ederim.Dönüş yaptığınız için teşekkür ederim.Son satırda da değerlendirme yapması için küçük bir ilave yaptım.Koda bakınız.Kolay gelsin