trier une liste de noms dans un autre onglet

Private Sub Worksheet_Activate()
  Set f = Sheets("référence")
  [A2:H10000].ClearContents
  For d = 0 To 6
    Set mondico = CreateObject("Scripting.Dictionary")
    For Each c In f.Range(f.Cells(2, 2 + d), f.Cells(65000, 2 + d).End(xlUp))
      If c = "x" Then mondico(c.Offset(, -1 - d).Value) = 1
    Next c
    Cells(2, 2 + d).Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
    Range(Cells(2, 2 + d), Cells(1000, 3 + d)).Sort Key1:=Cells(2, 2 + d), Order1:=xlAscending, Header:=xlNo
  Next d
  f.[A2:A10000].Copy [A2]
  [A1:A10000].Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess
 End Sub