Code to copy row and insert it below

[Brutusar]

Hi, I am writing a code where the complete row where the active cell is should be copied and pasted in a new row under. The code is below. The issue is that is copies the row that has the active cell, but also all rows below it. I guess it is because the active cell is being moved down. How can this be done correctly?

And, how should the code be if the same row should be pasted 2 times?

SubCopyRowBelowOneTime()


Dim myCell
Set myCell = ActiveCell

While ActiveCell.Value <> ""
Rows(ActiveCell.Row).Select
Selection.Copy
Selection.Insert Shift:=xlDown
myCell.Offset(1, 0).Select
Set myCell = ActiveCell
Wend

End Sub

 

[Fluff]

How about

Sub Brutusar()
   With ActiveCell
      .EntireRow.Copy
      Cells(.Row + 1, 1).Insert
   End With
End Sub

 

[Brutusar]

How about

Sub Brutusar()
   With ActiveCell
      .EntireRow.Copy
      Cells(.Row + 1, 1).Insert
   End With
End Sub

I have absolutely no idea why I tend to make things difficult. Very nice with people who know what they are doing. Working perfect, thank you very much!!

 

[Fluff]

You're welcome & thanks for the feedback.