Copy and paste data based on cell color

Sub steve73()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim lngROW As Long, lngCOL As Long
Dim rng As Range, cell As Range
Set ws1 = Sheets("Steves73-1")
Set ws2 = Sheets("Steves73-2")
With ws1
    lngROW = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
    lngCOL = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
    Set rng = ws1.Range(ws1.Cells(2, 3), ws1.Cells(lngROW, lngCOL))
    For Each cell In rng
        cell.Select
        Select Case cell.Interior.ColorIndex
            Case 3, 4, 6, 8
                Set rngcopy = ws1.Range(ws1.Cells(cell.Row, 1), ws1.Cells(cell.Row, 2))
                rngcopy.Copy
                With ws2
                    lngROW = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row
                    ws2.Range("A" & lngROW + 1).PasteSpecial xlPasteAll
                   ws1.Cells(1, cell.Column).Copy ws2.Range("C" & lngROW + 1)
                End With
        End Select
    Next cell
End With
End Sub