Comparer deux fichiers excel

Option Explicit
'

Sub CompareClasseurs()

    Dim BookXL1 As Workbook, BookXL2 As Workbook
    Dim rngOrg As Range, rngCible As Range
    Dim lngLimite As Long, lngBoucle As Long
    Dim lngLimCol As Long, lngBclCol As Long
    Dim lngIndiceRejets As Long
    Dim bolReponse As Boolean, varValeur As Variant
    
    ' Désactivation de l'affichage
    Application.ScreenUpdating = False
    
    ' Initialisation de pointeurs sur chaque fichier
    Set BookXL1 = Workbooks("Source.xls")
    Set BookXL2 = Workbooks("Compare.xls")
    
    ' Indicateur de rejets
    lngIndiceRejets = 0
    
    ' Nombre de lignes non vides, débutant en A1, jusqu'a A65536
    lngLimite = BookXL1.Sheets("Feuil1").Range("A1:A65536").End(xlDown).Row
    ' Boucle FOR de 1 à ... puisque la méthode .Range("AX")
    For lngBoucle = 1 To lngLimite
        ' Initialise un pointeur sur la cellule source
        Set rngOrg = BookXL1.Sheets("Feuil1").Range("A" & lngBoucle)
        ' Lire sa valeur
        varValeur = rngOrg.Value
        ' Trouver la cellule correspondante dans l'autre classeur
        bolReponse = TrouveLigne(BookXL2, varValeur, rngCible)
        If (bolReponse) Then    ' Est identique à If (bolReponse = True) Then
            ' Initialise compteur de colonnes
            lngBclCol = 0
            ' Tant Que Cellule De_Colonnes_Contigus Est Non-Vide, déplace à droite
            ' Ici, si la largeur est plutôt fixe, un FOR x = 1 TO y serait mieux
            While rngOrg.Offset(0, lngBclCol) <> ""
                ' Si valeur cible <> valeur source
                If rngCible.Offset(0, lngBclCol).Value <> rngOrg.Offset(0, lngBclCol).Value Then
                    ' Modifie couleur de la cible
                    rngCible.Offset(0, lngBclCol).Interior.ColorIndex = 4
                End If
                ' Incrémente compteur/pointeur de colonnes
                lngBclCol = (lngBclCol + 1)
            Wend
        Else
            ' Incrémente indicateur de rejets
            lngIndiceRejets = (lngIndiceRejets + 1)
        End If
        
    Next
    
    BookXL2.Activate
    Sheets("Feuil1").Select
    Range("A1").Select
    
    BookXL1.Activate
    Sheets("Feuil1").Select
    Range("A1").Select
    
    Set rngCible = Nothing
    Set rngOrg = Nothing
    Set BookXL1 = Nothing
    Set BookXL2 = Nothing
    
    
    Application.ScreenUpdating = True
    
End Sub
'

Function TrouveLigne(ByVal ThisBook As Workbook, _
                     ByVal LaValeur As Variant, _
                     ByRef rraLaCible As Range) As Boolean

    On Error GoTo Err_Trouveligne

    ThisBook.Activate
    Sheets("Feuil1").Select
    Cells.Find(What:=LaValeur, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Set rraLaCible = ActiveCell
    TrouveLigne = True
    
Exit_TrouveLigne:
    Exit Function
    
Err_Trouveligne:
    TrouveLigne = False

End Function
'