Araya Satır Ekle ve Yaz

[steppe]

Merhaba Arkadaşlar,
Aşağıdaki kod üzerinde epeyce uğraştım fakat bir türlü beceremedim. Epeyce denemeler yaptım fakat istediğim yere xxx yazdıramadım.

Sub araya_satir_ekle_yaz()
Dim str, i As Integer
Dim a, b, c, d As Boolean
str = Cells(Rows.Count, 1).End(3).Row

For i = str To 2 Step -1
a = IsDate(Cells(i - 1, 1))
b = Application.IsText(Cells(i, 1))
c = Application.IsText(Cells(i + 1, 1))
d = IsNumeric(Cells(i + 2, 1))

If a = True And b = True And c = True And d = True Then
Cells(i, 1).EntireRow.Insert
Cells(i, 1) = "xxx"
End If
Next i
End Sub

Tarihin altında bazen 2, bazen 3 metin olan satır bulunuyor. Yukarıdaki kod iki metin satırın üzerine satır ekleyerek xxx yazıyor. İki metin satırının üzerine değil de altına nasıl xxx yazdırabiliriz? Yardımlarınız için şimdiden teşekkür ederim.
Örnek
06.10.2021
aaaa
wwww
xxx
44444444
Şeklinde nasıl yazdırabiliriz?

​

​

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodu deneyin.

Sub araya_satir_ekle_yaz()
    Dim str, i As Integer
    Dim a, b, c, d As Boolean
    str = Cells(Rows.Count, 1).End(3).Row
    For i = str To 2 Step -1
        a = IsDate(Cells(i - 1, 1))
        b = Application.IsText(Cells(i, 1))
        c = Application.IsText(Cells(i + 1, 1))
        d = IsNumeric(Cells(i + 2, 1))
        If a = True And b = True And c = True And d = True Then
            Cells(i + 2, 1).EntireRow.Insert
            Cells(i + 2, 1) = "xxx"
        End If
    Next i
End Sub

 

[steppe]

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