Bonjour,
tu mets ce fichiers et tes fichiers 1 à 5 (et uniquements ceux-là) dans un répertoire dédié.
Cliquer sur MAJ
Sub score()
Dim datas, datas2, result, dict
Dim lig As Long, ano As Long, ano2 As Long
Dim chemin As String, Fichier As String
Dim wb As Workbook, wb2 As Workbook
Set dict = CreateObject("Scripting.Dictionary")
datas = [A2].Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1).Value
ReDim result(1 To UBound(datas), 1 To 1)
' email dans dictionary
For lig = 1 To UBound(datas)
If datas(lig, 1) <> "" Then dict(datas(lig, 1)) = lig
Next lig
Set wb = ThisWorkbook
chemin = wb.Path + "\"
Fichier = Dir(chemin & "*.xl*") ' 1er fichier
Application.ScreenUpdating = False
Do While (Len(Fichier) > 0)
If Fichier <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(chemin & Fichier)
' traitement
' !!! la feuille avec données doit être la 1ère !!!
With wb.Worksheets(1)
datas2 = .[A2].Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 1, 2).Value
End With
wb.Close
For lig = 1 To UBound(datas2)
If datas2(lig, 1) <> "" And datas2(lig, 2) <> "" Then
If dict.exists(datas2(lig, 1)) Then
If result(dict(datas2(lig, 1)), 1) <> "" Then ano2 = ano2 + 1
result(dict(datas2(lig, 1)), 1) = datas2(lig, 2)
Else
ano = ano + 1
End If
End If
Next lig
End If
Fichier = Dir() ' fichier suivant
Loop
[R2].Resize(UBound(result)) = result
MsgBox "Emails non trouvés dans " & ThisWorkbook.Name & " : " & ano & vbLf _
& "Doublons emails : " & ano2
End Sub
Doublons email signifie qu'un mail avec score a été trouvé plusieurs fois dans les fichiers 1 à 5.
Le dernier score lu est mis.
eric