Sub Colored()
Dim arrCells() As Variant, x As Long, y As Long
With ActiveSheet.UsedRange
arrCells = Range(.Columns(2), .Columns(.Columns.Count)).Value
For x = 1 To UBound(arrCells, 1)
For y = 2 To UBound(arrCells, 2)
If Not .Rows(x).Cells(1).Interior.ColorIndex = .Rows(x).Cells(y).Interior.ColorIndex Then
arrCells(x, 1) = arrCells(x, 1) & arrCells(x, y)
arrCells(x, y) = ""
End If
Next y
Next x
.Cells(2).Resize(UBound(arrCells, 1), UBound(arrCells, 2)).Value = arrCells
End With
End Sub