Sub InsertARow() 'Inserting Multiple Rows Between Existing Rows of Data
Dim j As Long
Dim r As Range
j = InputBox("Enter the number of rows to be inserted")
Set r = Range("A2") 'set range
Do While r.Value <> ""
    Set r = r.Offset(1, 0)
    For i = 1 To j
        r.EntireRow.Insert
    Next
Loop

End Sub