Sub TriCoulPolice()
Columns("C:C").Insert Shift:=xlToRight
For Each c In Range("b2", [b65000].End(xlUp))
c.Offset(0, 1) = c.Font.ColorIndex
Next c
Range("A2").CurrentRegion.Sort , Key1:=[C2], Header:=xlYes
Columns("c:c").Delete
End Sub