Copiar e colar na primeira linha vazia

Question

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 Sub

Obrigado!

Answer 1

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

Answer 2

Obrigado pela ajuda, André, mas ainda não deu certo. Ele ainda está escrevendo na primeira linha....

Answer 3

Poste o código na íntegra

Answer 4

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

Answer 5

 ActiveCell.Offset(1, 0).Select ' posiciona na primeira livre

O comando correto é este acima.

Não precisa do 'Range("F1").'

Answer 6

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

Answer 7

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 Sub

Abraço!

Answer 8

Maravilha, qualquer coisa estamos ai