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.
Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Juntar planilhas / copiar e colar com critérios
Re: Juntar planilhas / copiar e colar com critérios
CH7,
Veja se a rotina abaixo atende sua necessidade.
Adicione um módulo á pasta de trabalho, copie e cole o que segue :
Adicione um botão á aba VM e chame a rotina com call validarDados.
Espero ter ajudado.
Abs
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
Espero ter ajudado.
Abs