Coloration de doublons

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim cl As XlColorIndex 'déclare la variable cl (CouLeur)
Dim ld As Integer, lf As Integer, pl As Range 'déclare les variables ld (Ligne Début), lf (Ligne Fin) et pl (Plage Lignes)
Dim cd As Integer, cf As Integer, pc As Range 'déclare les variables cd (Colonne Début), cf (Colonne Fin) et pc (Plage Colonnes)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)

'si le double-clic a lieu ailleurs qu'en B2 ou F5, sort de la procédure
If Application.Intersect(Target, Application.Union(Range("B2"), Range("F5"))) Is Nothing Then Exit Sub
Cancel = True 'annule le mode édition lié au double-clic
cl = Target.Interior.ColorIndex 'définit la couleur cl
ld = Target.End(xlDown).Row 'définit la ligne de début
lf = Cells(Application.Rows.Count, Target.Column).End(xlUp).Row 'définit la ligne de fin
Set pl = Range(Cells(ld, Target.Column), Cells(lf, Target.Column)) 'définit la plage de lignes
cd = Target.End(xlToRight).Column 'définit la colonne de début
cf = Cells(Target.Row, Application.Columns.Count).End(xlToLeft).Column 'définit la colonne de fin
Set pc = Range(Cells(Target.Row, cd), Cells(Target.Row, cf)) 'définit la plage de colonnes
For Each cel In pl 'boucle tour toutes les cellules cel de la plage de lignes
    Set r = pc.Find(cel.Value, , xlValues, xlWhole) 'définit la recherche (recherche la valeur de la cellule dans la plage de colonnes)
    If Not r Is Nothing Then 'condition 2: si il existe au moins une occurrence trouvée
        pa = r.Address 'définit l'adresse de la première occurrence trouvée
        Do 'exécute
            cel.Font.ColorIndex = IIf(cel.Font.ColorIndex = 1, cl, 1) 'couleur de police de la cellule cel égale à cl ou noir
            r.Font.ColorIndex = IIf(r.Font.ColorIndex = 1, cl, 1) 'couleur de police de l'occurrence trouvée égale à cl ou noir
            Set r = pc.FindNext(r) 'redéfint la recherche (occurrence suivante)
        Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en pa
    End If 'fin de la condition 2
Next cel 'prochaine cellule de la boucle
End Sub