Boa Tarde,

Veja se é isso que precisa:

Sub copiar_linha()

Dim r, c  'r é a linha, c é a coluna

r = 2: c = 1 'r=2 significa linha 2, c=1 significa coluna A

Do While Planilha1.Cells(r, c) <> ""
Rows(r).Insert
Planilha1.Cells(r, c) = Planilha1.Cells(r + 1, c)
Planilha1.Cells(r, c + 1) = Planilha1.Cells(r + 1, c + 1)
Planilha1.Cells(r, c + 2) = Planilha1.Cells(r + 1, c + 2)
r = r + 2
Loop

End Sub

Dúvidas estou a disposição...

att

meu amigo ficou perfeita, já ajustei ela ao que preciso,

Obrigado,