Tomás Vásquez Fórum

Enviado: **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.

Enviado: **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

Tomás Vásquez Fórum

Juntar planilhas / copiar e colar com critérios

Juntar planilhas / copiar e colar com critérios

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