Automatically Add Rows to Excel File

[ekeenan81]

I have an excel file that is about 7,000 lines.

I want to have a macro that auto creates two blank rows in between each of these lines.

The best VBA code I have come up with only puts 2 rows at the top of the file which is not helpful.

Any help is appreciated

Ex.

A B C D E F G


X Y Z A B C D

Sub Insert_Rows_Loop()
Dim CurrentSheet As Object

' Loop through all selected sheets.
For Each CurrentSheet In ActiveWindow.SelectedSheets
' Insert 2 rows at top of each sheet.
CurrentSheet.Range("a1:a2").EntireRow.Insert
Next CurrentSheet
End Sub

 

[JackDanIce]

Try:

Sub Insert_Rows_Loop()
Dim i as Long, j as Long
For i = 1 to Worksheets.Count
     Sheets(i).Select  
     j = 1
     Do While Not IsEmpty(Range("A" & j))
        Range("A" & i).EntireRow.Resize(2).Insert
        j = j + 3
    Loop
Next i
End Sub

 

[ekeenan81]

Jack,

Thanks for the below code.

It is adding rows after the first row, but it is adding not 2, but a lot... over 500 when leaving the cursor in field A1, but the rest of the rows still have no blank rows in between.

 

[Weaver]

try

Sub Insert_Rows_Loop2()
    Dim ws, i
    For Each ws In ActiveWorkbook.Worksheets
        With ws
            lr = .Cells(Rows.Count, "A").End(xlUp).Row
            For i = lr To 1 Step -1
               .Range("A" & i).EntireRow.Resize(2).Insert
            Next i
        End With
    Next ws
End Sub

 

[ekeenan81]

Weaver,

This worked great.

Thank you as well as Jack for the pointers here.

Much appreciated.

 

[Weaver]

Weaver,

This worked great.

Thank you as well as Jack for the pointers here.

Much appreciated.

Good grief! you tested that one quick!

No problem.