Sub InsertRows()
Application.ScreenUpdating = False
Dim numRows As Integer
Dim r As Long
Dim X As Long
numRows = 2 'adjust for rows to insert
X = Cells(Rows.Count, 1).End(xlUp).Row 'last row in column A
For r = X To 1 Step -1
ActiveSheet.Rows(r + 1).Resize(numRows).EntireRow.Insert
Next r
Application.ScreenUpdating = True
End Sub


Gord Dibben MS Excel MVP

On Mon, 14 Apr 2008 11:51:00 -0700, CJ wrote:

what would the formula be if I wanted to insert 2 blank rows after each
existing data row?

"HKaplan" wrote:

Edit this simple macro:

Sub RowInsert()

For X = 2 To 12000
Rows(X).Select
Selection.Insert Shift:=xlDown
X = X + 1
Next X

End Sub