Sub Macro1()
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim x As Integer 'déclare la variable x (incrément)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim tv() As Variant 'déclare le tableau de variables indexées tv (Tableau de Variables)
With Sheets("Feuil1 (2)") 'prend en compte l'onglet "Feuil1 (2)"
dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne dl
Set pl = .Range("A2:A" & dl) 'définit la plage pl
For Each cel In pl 'boucle 1 : sur toutes les cellules de la plage pl
Erase tv: x = 0 'initialise le tableau tv, initialise la variable x
If Application.WorksheetFunction.CountIf(pl, cel.Value) > 1 Then 'condition 1 : le le nombre d'occurrences de la cellule cel est supérieur à 1
Set r = pl.Find(cel.Value, .Cells(dl, 1), xlValues, xlWhole) 'définit la recherche r
If Not r Is Nothing Then 'condition 2 : si il existe au moins une ocurrence
pa = r.Address 'définit la première adresse pa
Do 'exécute
ReDim Preserve tv(1, x) 'redimentionne le tableau tv
tv(0, x) = r.Row 'récupère en colonne 0 ligne x du tableau le numéro de ligne de r
tv(1, 0) = tv(1, 0) & r.Offset(0, 1).Value & "-" 'récupère en colonne 1, ligne 0 du tableau la valeur concaténée de la cellule adjacente à r
x = x + 1 'incrément x de +1
Set r = pl.FindNext(r) 'redéfinit la recherche r (recherche suivante)
Loop While Not r Is Nothing And r.Address <> pa 'boucle tnant qu'il existe de occurrences ailleurs qu'en pa
End If 'fin de la condition 2
For x = UBound(tv, 2) To 1 Step -1 'boucle 2 : inversée sur toutes les valeurs du tableau tv (sauf la première)
Rows(tv(0, x)).Delete 'supprime la ligne
Next x 'prochaine valeur de la boucle 2
.Cells(tv(0, 0), 2).Value = Left(tv(1, 0), Len(tv(1, 0)) - 1) 'place la valeur concaténée
End If 'fin de la condition 1
dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'redéfinit la dernière ligne dl
Set pl = .Range("A2:A" & dl) 'redéfinit la plage pl
Next cel 'prochaine cellule de la boucle 1
End With 'fin de la prise en compte de ...
End Sub