How to insert multiple rows between rows that already have data

[Thembela01]

Dear Gurus,

I need to add seven blank rows between rows that already have data. In other words, between every cell with data there must be seven blank rows

 

[Joe4]

One way:

Sub MyInsertRows()

    Dim lr As Long
    Dim r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row with data in column A
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through rows backwards
    For r = lr To 1 Step -1
        Rows(r + 1 & ":" & r + 7).Insert
    Next r

    Application.ScreenUpdating = True

End Sub