Sub InsertRows_()
Dim iEnd As Long
Dim iRow As Long

iEnd = Range("A1").CurrentRegion.Rows.Count
For iRow = iEnd To 1 Step -1
Rows(iRow + 1).Insert xlShiftDown
Next iRow
End Sub

Merjet