Like this?
Sub AAAAA()
Dim fr As Long, lr As Long, lc As Long, c As Range
fr = IIf(Len(Range("A1")) <> 0, 1, Range("A1").End(xlDown).Row)
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(fr, 1).End(xlToRight).Column
For Each c In Range(Cells(fr, 1), Cells(lr, lc)).SpecialCells(2)
If c.Interior.ColorIndex = 3 Then Cells(Rows.Count, 10).End(xlUp).Offset(1) = c.Value
Next c
End Sub
Or if you want to go Column by Column
Sub AAAAB()
Dim fr As Long, lr As Long, lc As Long, i As Long, ii As Long
fr = IIf(Len(Range("A1")) <> 0, 1, Range("A1").End(xlDown).Row)
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(fr, 1).End(xlToRight).Column
For i = 1 To lc
For ii = fr To lr
If Cells(ii, i).Interior.ColorIndex = 3 Then Cells(Rows.Count, 10).End(xlUp).Offset(1) = Cells(ii, 1).Value
Next ii
Next i
End Sub