Sub CompletePremier()
Dim MonDico As Object
Dim LigneCourante As Long, DerligneTableau As Long
Dim Lecture As String
Set MonDico = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
LigneCourante = 2
DerligneTableau = Range("A1").End(xlDown).Row
'Boucle de la 1° ligne de données à la derniére ligne non vide de la colonne B
Do While LigneCourante <= Range("A" & Rows.Count).End(xlUp).Row
Lecture = Cells(LigneCourante, "A")
'Si élément non connu ajout au dico et mémorise numéro de ligne, puis passe à la ligne suivante
If Not MonDico.Exists(Lecture) Then
MonDico(Lecture) = LigneCourante
LigneCourante = LigneCourante + 1
'Si élément connu dans dico alors lecture de la mémoire de ligne, concatene la colonne R puis efface la ligne courante
Else
Rows(DerligneTableau + 1).Insert
Rows(LigneCourante).Delete
LigneCourante = LigneCourante + 1
End If
Loop
Application.ScreenUpdating = True
End Sub