Création d'une liste

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim d As Object 'déclare la variable d (Dictionnaire)
Dim cel As Range 'déclare la variable cel (CELlule)

If Target.Column <> 2 And Target.Row = 1 Then Exit Sub 'si le changement a lieu ailleurs que dans la colonne B ou dans la ligne 1, sort de la procédure
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
dl = Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 2 (=B)
Set pl = Range("B2:B" & dl) 'définit la plage pl
Set d = CreateObject("Scripting.Dictionary") 'définit le dictionnaire d
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
    If cel.Value <> "" Then d(cel.Value) = "" 'si la cellule n'est aps vide alimente le dictionnaire d
Next cel 'prochaine celllule de la boucle
Range("R3").Resize(d.Count) = Application.Transpose(d.keys) 'place en R3 le dictionnaire sans doublon
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Application ScreeUpdating = False
'...
Application ScreeUpdating = True