Sub Liste()
Dim ref As Range, derlig&, dercol%, plage1 As Range, plage2 As Range
Dim d As Object, cel As Range, txt$
Set ref = [A1] 'à adapter, 1ère cellule du tableau
derlig = ref.End(xlDown).Row
dercol = ref.End(xlToRight).Column
Set plage1 = ref.Offset(, 1).Resize(derlig - ref.Row + 1, dercol - ref.Column)
Set plage2 = plage1.Offset(1)
'---liste des professeurs---
Set d = CreateObject("Scripting.Dictionary") 'pour liste sans doublons
For Each cel In plage2
txt = Application.Trim(cel)
If txt <> "" Then d(txt) = txt
Next
Rows(derlig + 3 & ":65536").ClearContents 'effacement préalable
If d.Count = 0 Then Exit Sub
With Cells(derlig + 3, ref.Column).Resize(d.Count) '3 lignes après la dernière
.Value = Application.Transpose(d.Keys)
.Sort ref, xlAscending, Header:=xlNo 'tri alphabétique
'---liste des classes avec fonction CLASSE---
With .Offset(, 1)
.FormulaR1C1 = "=CLASSE(" & plage1.Address(, , xlR1C1) & "," & "RC[-1])"
.Value = .Value 'suppression des formules (facultatif)
End With
End With
End Sub