Página 1 de 1

Copiar linha e colar caso não exista.

Enviado: 31 Mar 2020 às 23:22
por gmsinfo
Boa noite pessoal.

Faço algumas macros básicas para automatizar o meu trabalho mas estou com dúvida em como fazer isso.

Eu tenho 2 Sheets, o que eu preciso fazer é bater se um código existente na sheet 1 também existe na sheet 2, caso exista o mesmo vai ser desconsiderado, caso não exista eu preciso copiar esse código junto com o restante da linha para a sheet 2.

Alguém poderia me dar uma luz de como resolver?

Re: Copiar linha e colar caso não exista.

Enviado: 01 Abr 2020 às 09:13
por AfonsoMira
Boa tarde.

Penso que este código resolva o problema é só adaptar ao seu caso.

Caso necessite ajuda é só avisar. (Se quiser envie o arquivo que eu adapto)
Código: Selecionar todos
Sub pesquisa()
    Dim ultimaPlan1, ultimaPlan2, i As Long
    Dim codigo As Variant

    'seleciona planilha 1
    Sheets("Plan1").Select
    'Verifica ultima linha a ser utilizada na planilha 1
    ultimaPlan1 = Range("a1000000").End(xlUp).Row
    
    'Ciclo for para correr todos os valores da planilha 1
    For i = 1 To ultimaPlan1
        'seleciona plan 1
        Sheets("Plan1").Select
        
        'Define a variavel a pesquisar
        codigo = Cells(i, 1).Value

        'seleciona plan 2
        Sheets("Plan2").Select
        
        'Procura pela variável
        Set Rng = Cells.Find(What:=codigo, _
                             After:=ActiveCell, _
                             LookIn:=xlFormulas, _
                             LookAt:=xlPart, _
                             SearchOrder:=xlByRows, _
                             SearchDirection:=xlNext, _
                             MatchCase:=False)
                             
        'se encontrar não faz nada
        If Not Rng Is Nothing Then
        
        Else    'Caso encontre copia a linha da Planilha 1 e cola na ultima linha da Planilha 2
        
            'Seleciona Planilha 2
            Sheets("Plan2").Select
            'Verifica ultima linha a ser utilizada
            ultimaPlan2 = Range("a1000000").End(xlUp).Row
            
            'seleciona Planilha 1
            Sheets("Plan1").Select
            
            'Copia da Planilha 1 e cola na Planilha 2
            Worksheets("Plan1").Range((Cells(i, 1)), Cells(i, 3)).Copy Destination:=Worksheets("Plan2").Range("A" & ultimaPlan2 + 1)
            
        End If
        
    
    Next i
End Sub

Re: Copiar linha e colar caso não exista.

Enviado: 02 Abr 2020 às 00:19
por gmsinfo
AfonsoMira escreveu:Boa tarde.

Penso que este código resolva o problema é só adaptar ao seu caso.

Caso necessite ajuda é só avisar. (Se quiser envie o arquivo que eu adapto)
Código: Selecionar todos
Sub pesquisa()
    Dim ultimaPlan1, ultimaPlan2, i As Long
    Dim codigo As Variant

    'seleciona planilha 1
    Sheets("Plan1").Select
    'Verifica ultima linha a ser utilizada na planilha 1
    ultimaPlan1 = Range("a1000000").End(xlUp).Row
    
    'Ciclo for para correr todos os valores da planilha 1
    For i = 1 To ultimaPlan1
        'seleciona plan 1
        Sheets("Plan1").Select
        
        'Define a variavel a pesquisar
        codigo = Cells(i, 1).Value

        'seleciona plan 2
        Sheets("Plan2").Select
        
        'Procura pela variável
        Set Rng = Cells.Find(What:=codigo, _
                             After:=ActiveCell, _
                             LookIn:=xlFormulas, _
                             LookAt:=xlPart, _
                             SearchOrder:=xlByRows, _
                             SearchDirection:=xlNext, _
                             MatchCase:=False)
                             
        'se encontrar não faz nada
        If Not Rng Is Nothing Then
        
        Else    'Caso encontre copia a linha da Planilha 1 e cola na ultima linha da Planilha 2
        
            'Seleciona Planilha 2
            Sheets("Plan2").Select
            'Verifica ultima linha a ser utilizada
            ultimaPlan2 = Range("a1000000").End(xlUp).Row
            
            'seleciona Planilha 1
            Sheets("Plan1").Select
            
            'Copia da Planilha 1 e cola na Planilha 2
            Worksheets("Plan1").Range((Cells(i, 1)), Cells(i, 3)).Copy Destination:=Worksheets("Plan2").Range("A" & ultimaPlan2 + 1)
            
        End If
        
    
    Next i
End Sub
Vlw ajudou muito, obrigado por comentar o código assim eu consigo adaptar, está tudo praticamente certo falta só falta eu adaptar para ele não colar na última linha da tabela e sim na primeira linha em branco disponivel.

vlw.

Copiar linha e colar caso não exista.

Enviado: 02 Abr 2020 às 09:23
por AfonsoMira
Ainda bem que consegui ajudar. :D
Caso necessite de mais alguma ajuda só avisar.