Identifier donées communes à 2 fichiers

Sub ListeDoublonsDeuxTableaux()
Dim Wb1 As Workbook, Wb2 As Workbook
Dim Cell As Range
Dim Cible As Range
Dim Tableau()
Dim X As Byte, Y As Byte, Z As Byte, i As Byte
Dim Resultat As String, FirstAddress As String
 
'Définit les classeurs (supposés ouverts)
Set Wb1 = Workbooks("Classeur1.xls")
Set Wb2 = Workbooks("Classeur2.xls")
 
'Boucle sur les données de la feuille active dans le premier classeur
For Each Cell In Wb1.ActiveSheet.Range("A1:A10")
    Z = 0
    
    'Effectue la recherche dans le deuxième classeur
    With Wb2.ActiveSheet.Range("A1:A20")
        Set Cible = .Find(Cell, LookIn:=xlValues, lookAt:=xlWhole)
        'Si une donnée est trouvée
        If Not Cible Is Nothing Then
            
            FirstAddress = Cible.Address
            X = X + 1
            ReDim Preserve Tableau(1 To 2, 1 To X)
            
            Do
                Cible.Select
                Z = Z + 1
                Set Cible = .FindNext(After:=ActiveCell)
            'Recherche d'autres données identiques
            Loop While Not Cell Is Nothing And _
                Cible.Address <> FirstAddress
            
            'Alimente le tableau de résultat
            Tableau(1, X) = Cible
            Tableau(2, X) = Z
            Y = Y + Z
        End If
    End With
Next Cell
 
'affiche le résultat de la comparaison
Resultat = "Il y a " & Y & " données communes entre les deux tableaux  . " _
    & Chr(10) & Chr(10)
For i = LBound(Tableau(), 2) To UBound(Tableau(), 2)
Resultat = Resultat & Tableau(1, i) & Chr(9) & _
    Tableau(2, i) & " fois" & Chr(10)
Next i
 
MsgBox Resultat
End Sub