Usuário com melhor resposta
Copiar e colar na primeira linha vazia

Pergunta
-
Bom dia, pessoal.
Estou tentando criar uma macro para organizar e facilitar uma parte do meu trabalho. Mecanicamente é assim:
1) copio uma página da internet que contém dados de um cliente. CNPJ, nome, telefone etc.
2) colo na plan2 do excel
3) a macro copia apenas as células da plan 2 que são interessantes para mim (as que contém os dados como CNPJ, nome, telefone etc)
4) a macro cola esses dados na linha 2 da planilha 1. Portanto, o CNPJ vai na célula A2, nome na B2, telefone na C2.
O que eu não consigo fazer é com que a macro, na próxima vez que for executada, cole os dados nas células A3 B3 e C3, e assim por diante.
Podem me ajudar, por favor?
Segue o código que copia as células da planilha 2 e cola na planilha 1:
Sub Gravada()
'
' Gravada Macro
'
'
Range("B3").Select
Selection.Copy
Sheets("Plan1").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("Plan2").Select
Range("B29").Select
Selection.Copy
Sheets("Plan1").Select
Range("B2").Select
ActiveSheet.Paste
Sheets("Plan2").Select
Range("B14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Plan1").Select
Range("G2").Select
ActiveSheet.Paste
Sheets("Plan2").Select
Range("D5").Select
Selection.Copy
Sheets("Plan1").Select
Range("C2").Select
ActiveSheet.Paste
Sheets("Plan2").Select
Range("B6").Select
Selection.Copy
Sheets("Plan1").Select
Range("E2").Select
ActiveSheet.Paste
Sheets("Plan2").Select
Range("B5").Select
Selection.Copy
Sheets("Plan1").Select
Range("F2").Select
ActiveSheet.Paste
Sheets("Plan2").Select
Range("D3").Select
Selection.Copy
Sheets("Plan1").Select
Range("D2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End SubObrigado!
Respostas
-
Bom dia leo,
O comando abaixo irá descobrir para você a última linha preenchida e atribuir este valor a uma variável
Dim intLastRow as integer Sheets("Plan1").Select Range("B1").Select intLastRow = Sheets("Plan1").Range("B1").End(xlDown).Row
A partir dai é só você alterar o seu código para sempre colar na última linha preenchida + 1, conforme exemplo abaixo:
Range("B3").Select Selection.Copy Sheets("Plan1").Select Range("A" & intLastRow + 1).Select ActiveSheet.Paste Sheets("Plan2").Select Range("B29").Select
- Sugerido como Resposta André Santo terça-feira, 21 de julho de 2015 13:09
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator quinta-feira, 5 de novembro de 2015 15:38
-
André, consegui!!!!!!
Um amigo ajudou com um comando diferente do que estávamos pensando. Nesse modelo fiz só com 4 colunas. Amanhã vou repeti-lo para quantas colunas precisar. Funciona! Vou copiar para você ver a maneira.
Muito obrigado pela sua ajuda!
Segue:
Sub Macro1()
'
' Macro1 Macro
'
'
Sheets("Plan2").Select
Range("B4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Plan1").Select
i = 2
While i < 20
If Range("A" & i).Value = "" Then
Range("A" & i).Select
ActiveSheet.Paste
i = 20
End If
i = i + 1
Wend
' Range("A2").Select
'ActiveSheet.Paste
Sheets("Plan2").Select
Range("D3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Plan1").Select
i = 2
While i < 20
If Range("B" & i).Value = "" Then
Range("B" & i).Select
ActiveSheet.Paste
i = 20
End If
i = i + 1
Wend
'Range("B2").Select
'ActiveSheet.Paste
Sheets("Plan2").Select
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Plan1").Select
i = 2
While i < 20
If Range("C" & i).Value = "" Then
Range("C" & i).Select
ActiveSheet.Paste
i = 20
End If
i = i + 1
Wend
'Range("C2").Select
'ActiveSheet.Paste
Sheets("Plan2").Select
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Plan1").Select
i = 2
While i < 20
If Range("D" & i).Value = "" Then
Range("D" & i).Select
ActiveSheet.Paste
i = 20
End If
i = i + 1
Wend
'Range("D2").Select
'ActiveSheet.Paste
End SubAbraço!
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator quinta-feira, 5 de novembro de 2015 15:38
Todas as Respostas
-
Bom dia leo,
O comando abaixo irá descobrir para você a última linha preenchida e atribuir este valor a uma variável
Dim intLastRow as integer Sheets("Plan1").Select Range("B1").Select intLastRow = Sheets("Plan1").Range("B1").End(xlDown).Row
A partir dai é só você alterar o seu código para sempre colar na última linha preenchida + 1, conforme exemplo abaixo:
Range("B3").Select Selection.Copy Sheets("Plan1").Select Range("A" & intLastRow + 1).Select ActiveSheet.Paste Sheets("Plan2").Select Range("B29").Select
- Sugerido como Resposta André Santo terça-feira, 21 de julho de 2015 13:09
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator quinta-feira, 5 de novembro de 2015 15:38
-
-
-
André, segue. Mais uma vez, obrigado pela ajuda.
Sub Gravada()
'
' Gravada Macro
'
'
Sheets("Plan2").Select
Range("B3").Select
Selection.Copy
Sheets("Plan1").Select
Range("A" & intLastRow + 1).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select ' posiciona na primeira livre
ActiveSheet.Paste
Sheets("Plan2").Select
Range("B29").Select
Selection.Copy
Sheets("Plan1").Select
Range("A" & intLastRow + 1).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("B2").Select
ActiveSheet.Paste
Sheets("Plan2").Select
Range("B14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Plan1").Select
Range("G2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("G1").Select ' posiciona na primeira livre
ActiveSheet.Paste
Sheets("Plan2").Select
Range("D5").Select
Selection.Copy
Sheets("Plan1").Select
Range("C2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("C1").Select ' posiciona na primeira livre
ActiveSheet.Paste
Sheets("Plan2").Select
Range("B6").Select
Selection.Copy
Sheets("Plan1").Select
Range("E2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("E1").Select ' posiciona na primeira livre
ActiveSheet.Paste
Sheets("Plan2").Select
Range("B5").Select
Selection.Copy
Sheets("Plan1").Select
Range("F2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("F1").Select ' posiciona na primeira livre
ActiveSheet.Paste
Sheets("Plan2").Select
Range("D3").Select
Selection.Copy
Sheets("Plan1").Select
Range("D2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("D1").Select ' posiciona na primeira livre
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub -
-
Ainda não rodou. Ele foi parar na última linha. O depurador apontou o comando ActiveCell.Offset(1,0).Select ' com problema.... tem mais sugestões??
segue o código como ficou depois das modificações.
Sub Macro1()
'
' Gravada Macro
'
'
Sheets("Plan2").Select
Range("B3").Select
Selection.Copy
Sheets("Plan1").Select
Range("A" & intLastRow + 1).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select ' posiciona na primeira livre
ActiveSheet.Paste
Sheets("Plan2").Select
Range("B29").Select
Selection.Copy
Sheets("Plan1").Select
Range("A" & intLastRow + 1).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select ' posiciona na primeira livre
ActiveSheet.Paste
Sheets("Plan2").Select
Range("B14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Plan1").Select
Range("G2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select ' posiciona na primeira livre
ActiveSheet.Paste
Sheets("Plan2").Select
Range("D5").Select
Selection.Copy
Sheets("Plan1").Select
Range("C2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select ' posiciona na primeira livre
ActiveSheet.Paste
Sheets("Plan2").Select
Range("B6").Select
Selection.Copy
Sheets("Plan1").Select
Range("E2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select ' posiciona na primeira livre
ActiveSheet.Paste
Sheets("Plan2").Select
Range("B5").Select
Selection.Copy
Sheets("Plan1").Select
Range("F2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select ' posiciona na primeira livre
ActiveSheet.Paste
Sheets("Plan2").Select
Range("D3").Select
Selection.Copy
Sheets("Plan1").Select
Range("D2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select ' posiciona na primeira livre
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub -
André, consegui!!!!!!
Um amigo ajudou com um comando diferente do que estávamos pensando. Nesse modelo fiz só com 4 colunas. Amanhã vou repeti-lo para quantas colunas precisar. Funciona! Vou copiar para você ver a maneira.
Muito obrigado pela sua ajuda!
Segue:
Sub Macro1()
'
' Macro1 Macro
'
'
Sheets("Plan2").Select
Range("B4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Plan1").Select
i = 2
While i < 20
If Range("A" & i).Value = "" Then
Range("A" & i).Select
ActiveSheet.Paste
i = 20
End If
i = i + 1
Wend
' Range("A2").Select
'ActiveSheet.Paste
Sheets("Plan2").Select
Range("D3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Plan1").Select
i = 2
While i < 20
If Range("B" & i).Value = "" Then
Range("B" & i).Select
ActiveSheet.Paste
i = 20
End If
i = i + 1
Wend
'Range("B2").Select
'ActiveSheet.Paste
Sheets("Plan2").Select
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Plan1").Select
i = 2
While i < 20
If Range("C" & i).Value = "" Then
Range("C" & i).Select
ActiveSheet.Paste
i = 20
End If
i = i + 1
Wend
'Range("C2").Select
'ActiveSheet.Paste
Sheets("Plan2").Select
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Plan1").Select
i = 2
While i < 20
If Range("D" & i).Value = "" Then
Range("D" & i).Select
ActiveSheet.Paste
i = 20
End If
i = i + 1
Wend
'Range("D2").Select
'ActiveSheet.Paste
End SubAbraço!
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator quinta-feira, 5 de novembro de 2015 15:38
-