Ajuda aprimorar macro
Enviado: 22 Ago 2019 às 09:59
Bom dia pessoal!
Recentemente me ajudaram com um código aqui no fórum, hoje gostaria de pedir a ajuda para aprimorar um pouco esse código, ele transforma os dados bagunçados de uma planilha e cola em outra de forma organizada. Agora o que preciso:
- Que quando ele fizer essa colagem, ele não cole por cima dos dados que já estão lá, mas que procure a próxima linha em branco pra começar a colagem.
- E que seja possível colar dentro de uma tabela, da forma como ele está só cola se não houver tabela na planilha, com tabela ele da erro.
Segue o código
Sub Lançamento()
Application.ScreenUpdating = False
Set Novo = Sheets("BASE SOMBRA")
Set Orig = Sheets("Lançamento_base_sombra")
Col = 1
Novo.Rows("2:" & Rows.Count).Delete
Do
Orig.Select
Col = Col + 2
Data = Cells(1, Col).Value
If Data = "" Then Exit Do
Novo.Select
Lin = Cells(Rows.Count, 1).End(xlUp).Row + 1
Range(Cells(Lin, "A"), Cells(Lin + 102 - 3, "A")).Value = Data
Orig.Range(Orig.Cells(3, "A"), Orig.Cells(102, "B")).Copy (Cells(Lin, "B"))
Orig.Range(Orig.Cells(3, Col), Orig.Cells(102, Col + 1)).Copy (Cells(Lin, "D"))
Loop
Application.ScreenUpdating = True
End Sub
Muito obrigado!
Recentemente me ajudaram com um código aqui no fórum, hoje gostaria de pedir a ajuda para aprimorar um pouco esse código, ele transforma os dados bagunçados de uma planilha e cola em outra de forma organizada. Agora o que preciso:
- Que quando ele fizer essa colagem, ele não cole por cima dos dados que já estão lá, mas que procure a próxima linha em branco pra começar a colagem.
- E que seja possível colar dentro de uma tabela, da forma como ele está só cola se não houver tabela na planilha, com tabela ele da erro.
Segue o código
Sub Lançamento()
Application.ScreenUpdating = False
Set Novo = Sheets("BASE SOMBRA")
Set Orig = Sheets("Lançamento_base_sombra")
Col = 1
Novo.Rows("2:" & Rows.Count).Delete
Do
Orig.Select
Col = Col + 2
Data = Cells(1, Col).Value
If Data = "" Then Exit Do
Novo.Select
Lin = Cells(Rows.Count, 1).End(xlUp).Row + 1
Range(Cells(Lin, "A"), Cells(Lin + 102 - 3, "A")).Value = Data
Orig.Range(Orig.Cells(3, "A"), Orig.Cells(102, "B")).Copy (Cells(Lin, "B"))
Orig.Range(Orig.Cells(3, Col), Orig.Cells(102, Col + 1)).Copy (Cells(Lin, "D"))
Loop
Application.ScreenUpdating = True
End Sub
Muito obrigado!