Selecting Undefined multplie rows
 

I am trying to write a macro to copy seven rows of data and insert them right
after the seventh row and then go to the next 7 rows of data (as long as
there is data in column A) and copy them and insert them right after the 7th
row and continue on as long as there is data in column A.
I figure a Loop would be the easiest, this is what I have but it is
inserting 1 blank row. Any help would be appreciated. thanks

Do Until ActiveCell.Value = ""
If ActiveCell.Value 0 Then
ActiveCell.EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.EntireRow.Offset(1, 0).Select
Selection.Insert Shift:=x1Down
ActiveCell.EntireRow.Offset(1, 0).Select
Else
End If
Loop

Selecting Undefined multplie rows
 

I don't quite understand what you are trying. You want to copy to the column
until empty and you are copying to the same column??? Maybe you can give a
better example.

This macro will take cell 1-7 and copy to row 8

Sub copy7()
ac = ActiveCell.Column
lr = Cells(Rows.Count, ac).End(xlUp).Row + 1
For i = 8 To lr Step 7
Cells(1, ac).Resize(7,111).Copy Cells(lr, ac)
Next i
End Sub

This one will continue to the desired. This case 35
Sub copy7a()
ac = ActiveCell.Column
lr = Cells(Rows.Count, ac).End(xlUp).Row + 1
'For i = 8 To lr Step 7
For i = 8 To 35 Step 7
Cells(1, ac).Resize(7, 111).Copy Cells(lr, ac)
lr = lr + 7
Next i
End Sub


--
Don Guillett
SalesAid Software

"Curt D." wrote in message
...
I am trying to write a macro to copy seven rows of data and insert them
right
after the seventh row and then go to the next 7 rows of data (as long as
there is data in column A) and copy them and insert them right after the
7th
row and continue on as long as there is data in column A.
I figure a Loop would be the easiest, this is what I have but it is
inserting 1 blank row. Any help would be appreciated. thanks

Do Until ActiveCell.Value = ""
If ActiveCell.Value 0 Then
ActiveCell.EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.EntireRow.Offset(1, 0).Select
Selection.Insert Shift:=x1Down
ActiveCell.EntireRow.Offset(1, 0).Select
Else
End If
Loop