in need of macro to copy a row of data to another sheet based on text color of one cell

Hello all. i have searched around for such code to help me but have either run into things that don't work or things that i don't quite understand. I have many rows of data. in a specific column...say, "K", i have text in the form of either "YES" or "NO" and the text is colored either red or green. Based on the text color of that one cell, i need a macro that, when my button is pushed, will copy each entire row of data based on that yes or no cell to a different sheet in my workbook. this is what i am working with tho i know it is most likely way off.

Sub movefails()

Dim c As Range

    'If Selection.Columns.Count > 1 Then Exit Sub

    For Each c In Sheets("problems").Range("K5", "K").End(xlDown)
        If c.Font.Color = vbRed Then
            c.EntireRow.Copy
            Sheets("prodfail").Select
            Cells.Offset(1, 0).Select
            
            ActiveSheet.Paste
           
        End If
    Next c
End Sub

thanks!

Hi fredder,

I altered your code a little - see if it works now:

Sub movefails()

Dim c As Range, K As Range, wp As Worksheet
Set wp = Sheets("problems")
Set K = wp.Range("K5:K" & wp.Range("K" & Rows.count).End(xlUp))
   
    For Each c In K
        If c.Font.Color = vbRed Then
            c.EntireRow.Copy Sheets("prodfail").Cells.Offset(1, 0)
        End If
    Next c
End Sub

fredderf81,

The following works for me in a test worksheet.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub movefailsV2()
' stanleydgromjr, 09/20/2013
' http://www.excelforum.com/excel-programming-vba-macros/956607-in-need-of-macro-to-copy-a-row-of-data-to-another-sheet-based-on-text-color-of-one-cell.html
Dim c As Range, nr As Long
For Each c In Sheets("problems").Range("K5:K" & Cells(Rows.Count, "K").End(xlUp).Row)
  If c.Font.Color = vbRed Then
    nr = Sheets("prodfail").Range("K" & Rows.Count).End(xlUp).Offset(1).Row
    Rows(c.Row).Copy Sheets("prodfail").Range("A" & nr)
  End If
Next c
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the movefailsV2 macro.

You're welcome!