With some revision to insert two rows, not one.

Sub insertrows()
Dim i, lastRow As Long

Application.ScreenUpdating = False

lastRow = ActiveSheet.Cells(65536, "A").End(xlUp).Row
Rows(lastRow + 1).Select
For i = lastRow To 1 Step -1
ActiveCell.Resize(2).EntireRow.Insert
ActiveCell.Offset(-1, 0).EntireRow.Copy _
Destination:=ActiveCell.Resize(2)
Rows(i).Select
Next

Application.ScreenUpdating = True
End Sub


Gord Dibben MS Excel MVP

On Tue, 27 Jan 2009 14:38:08 -0800, Sheeloo <="to" & CHAR(95) & "sheeloo" &
CHAR(64) & "hotmail.com" wrote:

Here is the macro
Insert this in a module. It will work on the active sheet...

Sub insertrows()
Dim i, lastRow As Long

Application.ScreenUpdating = False

lastRow = ActiveSheet.Cells(65536, "A").End(xlUp).Row
Rows(lastRow + 1).Select
For i = lastRow To 1 Step -1
ActiveCell.EntireRow.Insert
ActiveCell.Offset(-1, 0).EntireRow.Copy Destination:=ActiveCell
Rows(i).Select
Next

Application.ScreenUpdating = True
End Sub

" wrote:

Of course I have to do it over and over, mabye 2 or three thousand times.
Please advise

"Sheeloo" wrote:

So you want to insert two rows below a row and copy that row to those two
inserted rows and do this for all rows?

Insert a number series next to the last Col (1,2,3,...)
Copy your data
Paste it below the last row
Paste again
Sort on the new col
and you are done

You will need a macro if you have to do it over and over again.


" wrote:

I have 1000 rows, and about 6 column.

I need a short cut to incert two rows between every
row and copy the data down.
so in other words make a one line entry into a three line
entry with the same datat in all three lines