Esqueceu sua senha? Você pode usar o mecanismo de lembrete neste link: Recuperar senha

Você receberá um link de reativação no email cadastrado.

Não recebeu o email? Lembre-se checar o Lixo Eletrônico.

Juntar planilhas / copiar e colar com critérios

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
CH7
Colaborador
Colaborador
Mensagens: 12
Registrado em: Qui Jan 31, 2019 12:13 pm

Juntar planilhas / copiar e colar com critérios

Mensagem por CH7 » Ter Mai 14, 2019 9:51 am

Bom dia, estou com algumas dificuldades de juntar duas planilhas. Essas planilhas tem dados iguais, uma planilha se chama VM (a que está faltando alguns dados) e a outra WL (a que tem todos os dados), mas esses dados iguais não estão em mesmas ordens, então o vba teria que filtrar por 3 critérios, no exemplo vão ser Marcas, Pessoas e id, não daria somente para filtrar por um critério só pois os dados que vem são muito parecidos, então precisa dos 3 critérios.

Então seria o seguinte, achar os critérios de uma planilha para outra e copiar e colar as informações que estão faltando na planilha VM, mandarei um zip com a planilha para um melhor entendimento.

Obrigado pela atenção. :D
Anexos
Teste.zip
(8.1 KiB) Baixado 37 vezes



Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


srobles
Jedi
Jedi
Mensagens: 759
Registrado em: Qua Mai 06, 2015 7:39 pm

Re: Juntar planilhas / copiar e colar com critérios

Mensagem por srobles » Sex Mai 24, 2019 3:25 pm

CH7,

Veja se a rotina abaixo atende sua necessidade.
Adicione um módulo á pasta de trabalho, copie e cole o que segue :

Código: Selecionar todos

Dim linhaIni As Long, linhaFim As Long
Dim retPeca As String, retQtde As String, retVendedor As String
Sub validaDados()
    Application.ScreenUpdating = False
    With ThisWorkbook.Sheets("VM")
        .Activate
        linhaIni = 2
        linhaFim = .Cells(Rows.Count, 1).End(xlUp).Row
        
            While linhaIni <= linhaFim
                Call pesquisaPersonalisada(.Cells(linhaIni, 2), .Cells(linhaIni, 1), .Cells(linhaIni, 3))
                With ThisWorkbook.Sheets("VM")
                    .Activate
                    .Cells(linhaIni, 5) = retPeca
                    .Cells(linhaIni, 6) = retQtde
                    .Cells(linhaIni, 7) = retVendedor
                End With
                linhaIni = linhaIni + 1
            Wend
        .Activate
        .Cells.EntireColumn.AutoFit
    End With
    Application.ScreenUpdating = True
    MsgBox "Operação concluída com sucesso!", vbInformation, "Validação de dados"
End Sub
Function pesquisaPersonalisada(ByVal Nome As String, ByVal Marca As String, ByVal ID As String)
    Dim vBusca
    Application.ScreenUpdating = False
    
    retPeca = "-"
    retQtde = "0"
    retVendedor = "-"
    
    With ThisWorkbook.Sheets("WL")
        .Activate
        
        With .Range("A:G")
            
            Set vBusca = .Find(ID)
            
                If Not vBusca Is Nothing Then
                    primeiraOcorrencia = vBusca.Address
                    Range(vBusca.Address).Select
                    If .Cells(vBusca.Row, 1) = Nome And .Cells(vBusca.Row, 2) = ID And .Cells(vBusca.Row, 3) = Marca Then
                        retPeca = .Cells(vBusca.Row, 5)
                        retQtde = .Cells(vBusca.Row, 6)
                        retVendedor = .Cells(vBusca.Row, 7)
                    Else
                        Do
                            Set vBusca = .FindNext(vBusca)
                            If .Cells(vBusca.Row, 1) = Nome And .Cells(vBusca.Row, 2) = ID And .Cells(vBusca.Row, 3) = Marca Then
                                Range(vBusca.Address).Select
                                retPeca = .Cells(vBusca.Row, 5)
                                retQtde = .Cells(vBusca.Row, 6)
                                retVendedor = .Cells(vBusca.Row, 7)
                                Exit Do
                            End If
                        Loop While vBusca.Address <> primeirOcorrencia
                    End If
                
                End If
        End With
        
    End With
End Function
Adicione um botão á aba VM e chame a rotina com call validarDados.

Espero ter ajudado.

Abs


Espero ter ajudado.

Abs.

Saulo Robles


Remember when you were young?
You shone like the sun.
Shine On You Crazy Diamond


Se suas dúvidas foram esclarecidas, acrescente ao lado do título o texto [RESOLVIDO].

Responder