Sub Macro1()
Range([A3], [B3].End(xlDown)).Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess
couleur = ""
For Each cel In Range([A3], [A3].End(xlDown))
If cel.Row = 3 Then couleur = cel.Offset(0, 1).Value
If cel.Value <> cel.Offset(-1, 0).Value Then
couleur = cel.Offset(0, 1).Value
ElseIf cel.Value = cel.Offset(-1, 0).Value Then
couleur = couleur & "," & cel.Offset(0, 1).Value
End If
If cel.Value <> cel.Offset(1, 0).Value And cel.Value = cel.Offset(-1, 0).Value Then
'couleur = couleur & "," & cel.Offset(0, 1).Value
cel.Offset(0, 1).Value = couleur
End If
Next
derlig = Range("A3").End(xlDown).Row
For lig = derlig To 3 Step -1
If Cells(lig, 1).Value = Cells(lig, 1).Offset(1, 0).Value Then Cells(lig, 1).Resize(1, 2).Delete shift:=xlShiftUp
Next
End Sub