Excel VBA - Inserting Multiple Rows Between Existing Rows of Data

[EverClear]

Hi there,

I have a file that contains nearly 1,300 rows of data. Between each row, I want to *insert* 4 blank rows. I certainly do not want to do this manually. I have some code, but unfortunately, it just results in an endless loop that ultimately leads me to force-close Excel.

Here is what I have so far:


Sub InsertARow()
'
'
'
Dim j As Long
Dim r As Range


j = InputBox("Enter the number of rows to be inserted")
Set r = Range("A2")

Do
Range(r.Offset(1, 0), r.Offset(j, 0)).EntireRow.Insert
Set r = Cells(r.Row + j + 1, 1)
MsgBox r.Address
If r.Offset(1, 0) = "" Then Exit Do

Loop
End Sub


Any help you can provide will be greatly appreciated!! THANK YOU!!!

 

[sericom]

Dim j As Long
Dim r As Range
j = InputBox("Enter the number of rows to be inserted")
Set r = Range("A2")
Do While r.Value <> ""
    Set r = r.Offset(1, 0)
    For i = 1 To j
        r.EntireRow.Insert
    Next
Loop

That will process until it hits a blank cell in column A

 

[EverClear]

FANTASTIC!!!! Thank you soooo much!!