Dim tx(1000) ' si besoin augmenter
Dim coul(1000)
For k = 1 To [A65000].End(3).Row
If Application.CountIf([A:A], Cells(k, 1)) = 1 Then _
n = n + 1: tx(n) = Cells(k, 1): coul(n) = Cells(k, 1).Interior.ColorIndex
'si couleur fonte .Font.ColorIndex au lieu .Interior.....
Next
[A:A].Value = "": [A:A].Interior.ColorIndex = xlNone
For k = 1 To n
Cells(k, 1) = tx(k)
Cells(k, 1).Interior.ColorIndex = coul(k)
Next 'si entete 2 to n+1