For this to work on selection

replace the line
lastRow = ActiveSheet.Cells(65536, "A").End(xlUp).Row

with
lastRow = Selection.Rows.Count

Someone may help you with the code for multiple selection

"Justaddcat" wrote:

Thankyou, this works very well to copy down every row, which will be helful
some somes. Is there a way to do this but only copy down selected rows? and
in multiple selections?
eg. 1, 2, 2, 3, 4, 5, 5, 6, 6, 7, 8, 8, 9...
Thankyou again.

"Sheeloo" wrote:

Try the macro
(to run open the worksheet you want it to run on, press Alt-F11, choose
Insert-Module, paste the code below, press F5)
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

"Justaddcat" wrote:

How can I copy all selected rows to insert each directly below without
individually copying then inserted each row one at a time?
Essentally I need ROW 1, 1, 2, 2, 3, 3, 4, 4, etc.? (I know the rows will
be in numerical order)
Thanks.