none
Copiar e colar na primeira linha vazia RRS feed

  • 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 Sub

    Obrigado!

    terça-feira, 21 de julho de 2015 11:50

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

    terça-feira, 21 de julho de 2015 13:09
  • 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!

    quarta-feira, 22 de julho de 2015 00:20

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

    terça-feira, 21 de julho de 2015 13:09
  • Obrigado pela ajuda, André, mas ainda não deu certo. Ele ainda está escrevendo na primeira linha....

    terça-feira, 21 de julho de 2015 17:06
  • Poste o código na íntegra
    terça-feira, 21 de julho de 2015 17:34
  • 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

    terça-feira, 21 de julho de 2015 18:33
  •  ActiveCell.Offset(1, 0).Select ' posiciona na primeira livre

    O comando correto é este acima.

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

    terça-feira, 21 de julho de 2015 20:03
  • 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

    terça-feira, 21 de julho de 2015 23:53
  • 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!

    quarta-feira, 22 de julho de 2015 00:20
  • Maravilha, qualquer coisa estamos ai
    quarta-feira, 22 de julho de 2015 10:48