Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Dico As Object, C As Range, DerLig As Long
DerLig = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
Range("H2:H" & DerLig).ClearContents
Set Dico = CreateObject("Scripting.Dictionary")
For Each C In Range("A1:A" & DerLig)
Dico(C.Value) = ""
Next C
[H2].Resize(Dico.Count, 1) = Application.Transpose(Dico.keys)
[H1].Sort Key1:=[H2], Order1:=xlAscending, Header:=xlYes
Application.ScreenUpdating = True
End Sub