Sub copyRowToBelow()
Dim rng As Range
Set rng = Range("A1") ' <~~ Change this
Do While (rng.Value <> "")
' Insert a row below the current one
rng.Offset(1).Insert
' Copy the current row and paste it into the row we just inserted
rng.EntireRow.Copy rng.Offset(1)
' Set the range declaration for 2 rows below the current one
Set rng = rng.Offset(2)
Loop
End Sub
A linha marcada ("Change this") pode ser declarada no código, ou você pode trocá-la por Set rng = ActiveCell
se quiser que ela seja executada na célula em que o usuário está trabalhando no momento da execução da macro .
Os comentários não são necessários para o código, eles estão lá apenas para ajudá-lo a aprender mais sobre o VBA.