Este fórum está sendo desativado

[Leonardo1234]

Olá Pessoal,

Eu tenho uma planilha em que eu preciso duplicar as linhas copiando e colando os conteúdos das células de cada linha na nova linha duplicada. Eu consegui fazer uma macro em que eu realizo isso de forma automática, porém ela funciona apenas linha por linha. Eu gostaria de poder duplicar todas as linhas com um único comando. Agradeço a ajuda e segue a planilha em anexo.

[osvaldomp]

Experimente:

Código: Selecionar todos

Sub DuplicaLinhas()
 Dim LR As Long
  Application.ScreenUpdating = False
  LR = Cells(Rows.Count, 1).End(3).Row
  Range("D1:D" & LR) = "=ROW()": Range("D1:D" & LR).Value = Range("D1:D" & LR).Value
  Range("D1:D" & LR).Copy Range("D" & LR + 1)
  Range("A1:D" & 2 * LR).Sort Key1:=[D1], Order1:=xlAscending
  Range("A1:D" & 2 * LR).SpecialCells(xlBlanks) = "=R[-1]C"
  Range("A1:D" & 2 * LR).Value = Range("A1:D" & 2 * LR).Value: [D:D] = ""
End Sub

[Leonardo1234]

Funcionou perfeitamente. Muito obrigado.