Renvoyer une liste sans les doublons

Private Sub Worksheet_Activate()
Dim D As Object, Pl As Range, Pl2 As Range, R As Range, i&, temp

  With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: .DisplayAlerts = 0: End With
  Set D = CreateObject("Scripting.Dictionary")
  With Me.[A1]: .Parent.Range(.Cells, .End(xlDown)).Clear: End With
  With Sheets("Feuil1"): Set Pl = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown)): End With
  For Each R In Pl: D(R.Value) = "": Next
  temp = D.keys
  Set Pl2 = Me.[A1].Resize(D.Count, 1)
  For Each R In Pl2: R = temp(i): i = i + 1: Next R
  Set D = Nothing
  With Application: .DisplayAlerts = 1: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With
End Sub

Private Sub Worksheet_Activate()
Dim i&, a(), b(), d As New Scripting.Dictionary
    With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With
    With Me.[A1]: .Parent.Range(.Cells, .End(xlDown)).Clear: End With
    With Sheets("Feuil1"): Me.[A1].Value = .Cells(1, 1).Value: a = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown)).Value: End With
    For i = 2 To UBound(a): d(a(i, 1)) = "": Next
    b = d.keys
    Set d = Nothing
    ReDim a(UBound(b), 0)
    For i = 0 To UBound(b): a(i, 0) = b(i): Next
    Me.[A1].Offset(1).Resize(UBound(b) + 1, 1) = a
    With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With
End Sub