Inserting Multiple Rows Between List

This might be useful for you - - this macro will ask you how many rows you want to add in between contiguous records, in case you change your mind from 6 to something else.

If for example your list of 1000 clients starts in A2 and goes to A1001, then click on cell A2 and run this macro.

Sub InsertRows()
Dim InsQuan As Integer
On Error Resume Next
InsQuan = InputBox("Enter number of rows to insert", "Your Call")
If InsQuan <= 0 Then
MsgBox "Invalid number entered", vbCritical, "Stop!"
Exit Sub
End If
Application.ScreenUpdating = False
Do Until Selection.Value = ""
ActiveCell.Offset(1, 0).Range("A1:A" & InsQuan).Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(InsQuan, 0).Select
Loop
[A1].Select
Application.ScreenUpdating = True
End Sub

Remember, this code is most effective (not useless, just most effective) for a list of contiguous records (i.e. no blanks in between A2 and A1001).

Tom Urtis

Actually, inserting records is not as efficient
as "sorting in" blank rows. Here's how...

1. Temporarily number your rows (e.g., 1 to 1000)
in an unused column.
2. Copy these number and Paste 6 more copies of
them in cells right beneath one another.
3. Sort on this column of numbers.
4. Delete the column when done.

Or .....

.... this one should be a bit quicker (it's based on the steps outlined in Mark W's response) :-

Sub InsertRows()
Dim InsQuan As Integer, rng As Range, r As Integer
On Error Resume Next
InsQuan = InputBox("Enter number of rows to insert", "Your Call")
If InsQuan <= 0 Then
MsgBox "Invalid number entered", vbCritical, "Stop!"
Exit Sub
End If

Set rng = Range([A1], [A65536].End(xlUp)) 'Change column as required

r = rng.Rows.Count
rng(1, 1).EntireColumn.Insert
Set rng = rng.Offset(0, -1)
With rng(1, 1)
.Value = 1
.AutoFill Destination:=rng, Type:=xlFillSeries
End With
With rng
.Copy .Offset(r, 0).Resize(r * InsQuan, 1)
.Resize(r * (InsQuan + 1), 256).Sort Key1:=rng(1, 1), Order1:=xlAscending, Header:=xlNo
.EntireColumn.Delete
End With
End Sub