Copy Yellow Cells in Row 2 of Sheet1 sequentially to Sheet2

Question

I want to search through cells in Row 2 of worksheet "In Motion". If a cell is highlighted yellow, I want to copy the entire column and paste it to worksheet "Dashboard". I want this to repeat to find every yellow cell in row 2 of "In Motion". I also want the columns to paste sequentially onto "Dashboard".

The code I have, which I've built partly from running macros doesn't work. It DOES copy the column of the first yellow cell it finds on "In Motion" and pastes to A1 of "Dashboard". But, it DOES NOT loop through all the cells in row 2. It just stops.

Also, I think if the loop were working, my code wouldn't effectively paste columns sequentially to "Dashboard". I think they'd all be pasting to A1.

Sorry for the noob quesiton. Help is greatly appreciated!

Sub AutoPopulateNew()
Dim C As Range

'Clear Dashboard
Worksheets("Dashboard").Activate
Worksheets("DashBoard").Cells.ClearContents

'Move to In Motion Sheet
Worksheets("In Motion").Activate

'Find and copy yellow highlighted cells
For Each C In Worksheets("In Motion").Rows("2:2")
    C.Select
        With Application.FindFormat.Interior.Color = 65535
        End With
    Selection.Find(What:="", LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchFormat:=True).Activate
    ActiveCell.EntireColumn.Copy _
        Destination:=Worksheets("Dashboard").Range("A1")
    Next C

Worksheets("Dashboard").Activate

End Sub

Answer 1

You don't need to activate a sheet to write in it. I like to use RGB declaration of colors and(255,255,0) is yellow. You can use vbYellow instead too. To find out the RGB numbe of any color, select the cell, goto the buckets icon that colors the background, choose more colors and then custom to see the RGB numbers. This code will do that, edit as you need.

Sub AutoPopulateNew()
Dim i As Integer
Dim j As Integer
Dim count As Integer
Dim c As Range

'Clear Dashboard sheet
Worksheets("DashBoard").Cells.ClearContents

count = 1 'counts the cells with a matching background color

'Loop through the cells and check if the background color matches
For Each cell In Worksheets("In Motion").Rows(2).Cells
    If cell.Interior.Color = RGB(255, 255, 0) Then
        Worksheets("Dashboard").Cells(1, count).Value = cell.Value
        count = count + 1
    End If
Next cell

End Sub

Answer 2

Thanks Ibo for the help! The loop worked going through the highlighted cells.

For what it's worth, I ended up changing my approach to copying and pasting columns based on whether they are marked with "x" in a given row. Code is below if it helps anyone who stumbles here.

Sub AutoPopulateX()
Dim SingleCell As Range
Dim ListofCells As Range
Dim i As Integer

'Clear Dashboard
    Worksheets("Dashboard").Activate
    Worksheets("DashBoard").Cells.ClearContents

'Move to In Motion and Set Range
    Worksheets("In Motion").Activate
    Application.Goto Range("a1")

    Set ListofCells = Worksheets("In Motion").Range("a2:ba2").Cells

    i = 1
    Set SingleCell = Worksheets("In Motion").Cells(2, i)

'Loop: search for xyz and copy paste to Dashboard
    For Each SingleCell In ListofCells
        If InStr(1, SingleCell, "x", 1) > 0 Then
                Range(Cells(3, i), Cells(Rows.count, i)).Copy
                Worksheets("Dashboard").Paste Destination:=Worksheets("Dashboard").Cells(1, Columns.count).End(xlToLeft).Offset(0, 1)
        End If
        Application.Goto Range("a1")
        i = i + 1
    Next SingleCell

'Clean up Dashboard
    Worksheets("Dashboard").Columns("a").Delete
    Worksheets("Dashboard").Activate

End Sub