Her 5 satırda 1 boşluk bırakmak makro

[u.L.a.s]

merhabalar

aşağıdaki kod düzeneğimde

dolu hücrelerimde 5 satır boşluk bıraktırıyorum.

1. sorum ben bunu her 5 dolu hücremden sonra 5 satır boşluk bırakmak istiyorum (1. Satır Başlık olarak kalacak 2,3,4,5,6 ilk 5 satırım olacak)
2. sorum ise Rows(i).Insert Shift:=xlDown komutunu 5 kere yazmak yerine 1 kere bir komutla 5 satır boşluk bırakma işlemini nasıl yaparım

Sub satirAc()
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
        If Cells(i, 1).Value <> Empty And Cells(i - 1, 1).Value <> Empty Then
            Rows(i).Insert Shift:=xlDown
            Rows(i).Insert Shift:=xlDown
            Rows(i).Insert Shift:=xlDown
            Rows(i).Insert Shift:=xlDown
            Rows(i).Insert Shift:=xlDown
        End If
    Next i
    Range("A1").Select
MsgBox ("Boş Satırlar Açılmıştır "), vbInformation, "Uyarı"
End Sub

 

[u.L.a.s]

1. sorum için kod düzeneğinde şu nu yapmak yeterliymiş

For i = Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -5

 

[EmrExcel16]

Deneyiniz..
2 alternatif 1. kod her 5 satırda bir 5 satır boşluk verir , 2. kod her dolu 5 satırda 5 satır boşluk verir.

Sub satirAc()
    For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row * 2 Step 10
        Rows(i & ":" & i + 4).Insert Shift:=xlDown
    Next i
MsgBox ("Boş Satırlar Açılmıştır "), vbInformation, "Uyarı"
End Sub

Sub satirAc1()
    i = 2
    While i < Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 1).Value <> Empty And Cells(i + 1, 1).Value <> Empty And Cells(i + 2, 1).Value <> Empty And Cells(i + 3, 1).Value <> Empty And Cells(i + 4, 1).Value <> Empty And Cells(i + 5, 1).Value <> Empty Then
            Rows(i + 5 & ":" & i + 9).Insert Shift:=xlDown
            i = i + 10
        Else
            i = i + 1
        End If
    Wend
    MsgBox ("Boş Satırlar Açılmıştır "), vbInformation, "Uyarı"
End Sub

 

[u.L.a.s]

Üstadım emeğine bilgine sağlık teşekkür ederim.

 

[EmrExcel16]

Üstadım emeğine bilgine sağlık teşekkür ederim.

Rica ederim , iyi çalışmalar.