Sub nommer()
Dim Listes As Object
Dim Cel As Range
Dim It
Dim DerLig As Long
Set Listes = CreateObject("Scripting.Dictionary")
With Sheets("Feuil1")
DerLig = .[B65000].End(xlUp).Row
.Range("B6:D" & DerLig).Sort Key1:=.Range("B7"), Order1:=xlAscending, Header:=xlYes
For Each Cel In .Range("B7:B" & DerLig)
Listes.Item(Cel.Value) = Cel.Value
Next Cel
End With
For Each It In Listes.Items
ActiveWorkbook.Names.Add Name:=It, RefersToR1C1:= _
"=OFFSET(Feuil1!R1C2,MATCH(""" & It & """,Feuil1!C2,0)-1,2,COUNTIF(Feuil1!C2,""" & It & """))"
Next It
End Sub