Este fórum está sendo desativado

[Domingsp]

Olá, boa tarde.Anexei dois arquivos, pasta2 e pasta3.
Essa pastas tem placas de veiculos ficticias. Com a macro TESTEPLACAS eu quero:
1) encontrar placas que constam nos dois arquivos;
2) encontrando, marcar 1, na coluna B da pasta2, na linha correspondente à placa presente nas duas pastas.

Só que a macro não tinha que marcar a WXD-4655 e a EOED-3431 da pasta2 porque elas não correspodem a nenhuma placa da pasta3. Talvez, o problema esteja nos loop. Não tenho prática em trabalhar com arquivos diferentes.
Eu coloquei umas setas nessas placas apenas para mostrar o erro.
Qualquer ajuda é bemvinda.

TESTE.rar

[gfranco]

Boa tarde.
Poderia usar apenas um procv dentro se uma função "se" para verificar se a placa consta no outro arquivo e retornar 1 caso o procv não retorne erro e qualquer outro retorno para o caso de não encontrar.
A função procv está entre as que conseguem se atualizar mesmo com o aquivo fechado.

[Domingsp]

A quantidade de dados (placas) nas pastas vai variar. Uma solução por macro não seria melhor nesse caso?

[gfranco]

Já que o cenário é esse, eu elencaria como primeira opção o power query.
Transformaria os dois intervalos de dados (das duas pastas) em tabela.
Uma vez os dados no editor de consultas, uma mescla simples me retornaria os dados que estão em ambas as tabelas,
Depois um filtro eliminando as linhas que retornaram nulas e eu teria um consolidado das placas presentes em ambas as pastas de trabalho.

[alexandrevba]

Boa tarde!!

Use nossa base de dados, pois há respostar similar a sua dúvida!

Código: Selecionar todos

Sub AleVBA_6344()
'Este arquivo deve ficar fora do diretório \TESTE\
Application.ScreenUpdating = False
Dim wkbDest As Workbook
Dim wkbSource As Workbook
Set wkbDest = ThisWorkbook
Dim lr As Long
lr = Range("A1").SpecialCells(xlCellTypeLastCell).Row
Dim LastRow As Long
Const strPath As String = "C:\Users\Administrador\Downloads\TESTE\"
    wkbDest.ActiveSheet.Range("A1").CurrentRegion.Clear
    [A1].Value = "Placas": [B1].Value = "Valor"
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            LastRow = .Sheets("Plan1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Sheets("Plan1").Range("A1:A" & LastRow).Copy wkbDest.Sheets("alevba").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Range("B2").Formula = "=COUNTIF($A:$A,A2)"
    Range("B2").AutoFill Destination:=Range("B2:B" & lr)
    With Range("A1:B100")
        .Value = .Value
    End With
    Worksheets("alevba").Range("B1").AutoFilter Field:=2, Criteria1:="1"
    ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
    Application.DisplayAlerts = False
    ActiveSheet.[A1].CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
    ActiveSheet.ShowAllData
    'Use o With Statement acima, para evitar repetição
Application.ScreenUpdating = True
End Sub

Att

[Domingsp]

Obrigado!