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