Sub TriNbCar()
[B:B].Insert Shift:=xlToRight
For Each c In Range([A2], [A65000].End(xlUp))
c.Offset(0, 1).Value = Len(c)
Next c
[B2].CurrentRegion.Sort Key1:=[B2], Key2:=[A2], Order1:=xlAscending, Header:=xlGuess
[B:B].Delete
End Sub