'************************************************************************
'  Tell the box how many rows you want to insert
'                   ~~ AJ ~~
'*************************************************************************

Sub InsertMultipleRows()

Dim i As Integer
Dim j As Integer

ActiveCell.EntireRow.Select

On Error GoTo Last

i = InputBox("Number of rows to insert", "Insert Rows")

For j = 1 To i

Selection.Insert Shift:=xlToDown, CopyOrigin:=xlFormatFromRightorAbove

Next j
Last:
Exit Sub
End Sub