Sub compter()
Application.ScreenUpdating = False
Sheets("Feuil1").Columns("B:B").ClearContents
x = Timer
'Compter les cellules identiques
ligne = Sheets("Feuil1").Range("A1000000").End(xlUp).Row
NbCodes = 0
For i = 1 To ligne
doc = Sheets("Feuil1").Cells(i, 1).Value
For j = 2 To ligne
If Sheets("Feuil1").Cells(j, 1).Value = doc Then NbCodes = NbCodes + 1
Next j
Sheets("Feuil1").Cells(i, 2).Value = NbCodes
NbCodes = 0
Next i
Application.ScreenUpdating = True
MsgBox x
End Sub