Copy a row to another sheet based on cell fill color

**swatkins1977** · 10-19-2012, 04:29 PM

I'm sure that this has been covered before but I can't seem to find it. I want a macro that will copy an entire row from one sheet to another based on the fill color of one cell. Since I will be continually adding to the main sheet this will need to copy to the next empty row when it runs.

In my sample attachment, if the cell is green I want the row copied to the "Good" sheet and if it is red to the "Bad" Sheet.

Thanks for any help.

Steve

**patel45** · 10-19-2012, 05:20 PM

Sub a()
LR = Sheets("Log").Cells(Rows.Count, "A").End(xlUp).Row
Grow = 2: Brow = 2
With Sheets("Log")
  For j = 2 To LR
    col = .Cells(j, 6).Interior.ColorIndex
    If col = 35 Then
      .Rows(j).Copy Sheets("Good").Rows(Grow)
      Grow = Grow + 1
    End If
    If col = 38 Then
      .Rows(j).Copy Sheets("Bad").Rows(Brow)
      Brow = Brow + 1
    End If
  Next
End With
    
End Sub

**mrice** · 10-19-2012, 05:22 PM

Try pasting the following copy into the specified sheets in the VBA editor (Alt F11)

Into Sheet2(Good)

Private Sub Worksheet_Activate()
Cells.Clear
Sheets("Log").Rows(1).Copy Destination:=Rows(1)
For N = 2 To Sheets("Log").UsedRange.Rows.Count
    If Sheets("Log").Cells(N, 6).Interior.ColorIndex = 35 Then
        Sheets("Log").Rows(N).Copy Destination:=Rows(UsedRange.Rows.Count + 1)
    End If
Next N
End Sub

Into Sheet3(Bad)

Private Sub Worksheet_Activate()
Cells.Clear
Sheets("Log").Rows(1).Copy Destination:=Rows(1)
For N = 2 To Sheets("Log").UsedRange.Rows.Count
    If Sheets("Log").Cells(N, 6).Interior.ColorIndex = 38 Then
        Sheets("Log").Rows(N).Copy Destination:=Rows(UsedRange.Rows.Count + 1)
    End If
Next N
End Sub

The code works by regenerating the good and bad sheets every time that they are activated so that they are always in sync with the Log sheet.

**swatkins1977** · 10-22-2012, 07:19 AM

Thanks for the help. Martin, your solution is copying over as I want but it pastes it down below any row that has been previously used so every time it copies it goes further down the sheet and leaves all the rows above it empty. Any ideas on this?

It is actually working better than I had hoped with the exception of pasteing so far down.

Thanks,

Steve