Hello Wayne,

Here is a VBA macro version. To use it , add a VBA Module to your
project code. You can then run it by selecting it the Macro Dialog Box.
To display the available macros in Excel press ALT + F8.

Code:
--------------------

Public Sub SplitAndCopyRows()

Dim Cell As Range
Dim I As Long
Dim LastRow As Long
Dim NextRow(3) As Long
Dim MainWks As Worksheet
Dim Wks As Worksheet

Set MainWks = Worksheets("Sheet1")
LastRow = MainWks.Range("A" & MainWks.Rows.Count).Row

With Worksheets("Sheet2")
NextRow(1) = .Range("A" & .Rows.Count).End(xlUp).Row
End With

With Worksheets("Sheet3")
NextRow(2) = .Range("A" & .Rows.Count).End(xlUp).Row
End With

With Worksheets("Sheet4")
NextRow(3) = .Range("A" & .Rows.Count).End(xlUp).Row
End With

For Each Cell In MainWks.Range("A1:A" & LastRow)
Select Case LCase(Cell.Value)
Case Is = "red"
Set Wks = Worksheets("Sheet2")
I = 1
GoSub CopyToNextRow
Case Is = "yellow"
Set Wks = Worksheets("Sheet3")
I = 2
GoSub CopyToNextRow
Case Is = "green"
Set Wks = Worksheets("Sheet4")
I = 3
GoSub CopyToNextRow
End Select
Next Cell

Exit Sub

CopyToNextRow:
If NextRow(I) < 1 Or (NextRow(I) = 1 And Wks.Cells(1, 1).Value < "") Then
NextRow(I) = NextRow(I) + 1
End If
MainWks.Range(Cell.Address).EntireRow.Copy Destination:=Wks.Range("A" & NextRow(I)).EntireRow
Return

End Sub
--------------------


Sincerely,
Leith Ross


--
Leith Ross
------------------------------------------------------------------------
Leith Ross's Profile: http://www.excelforum.com/member.php...o&userid=18465
View this thread: http://www.excelforum.com/showthread...hreadid=551680