Sub CopyColor()
Dim cl As Range
For Each cl In Range("$A$2:$A" & Cells(Rows.Count, "A").End(xlUp))
If cl.Interior.ColorIndex = 5 Then cl.Copy Cells(cl.Row, "B")
Next cl
End Sub
Sub CopyColor()
Dim cl As Range
For Each cl In Selection
If cl.Interior.ColorIndex = 5 Then cl.Copy Cells(cl.Row, "A")
Next cl
End Sub