Copying Row to another Worksheet based on multiple criteria.

[noveske]

Attempting to copy over a row based on multiple criteria. Was able to get it to work with matching just one criteria.
Lost with how to add the second criteria. Trying and statements but I think I'm just way off. Got lost since if status is for criteria1, then how to add in criteria2 and second range.

Seeing how to make it one module and if it's possible to update dynamically (live) or on sheet change / save so buttons wouldn't be needed.


Column D contains:
6-2
2-10

Column F contains:
O
P
S
2
3
4

Trying to figure out:
If 6-2 and 2, 3, or 4 copy to Sheet6.
If 2-10 and 2, 3, or 4 copy to Sheet7.

Successful:
If 6-2 copy to Sheet6.
If 2-10 copy to Sheet7.

Sub Copy1()

Dim StatusCol As Range
Dim Status As Range
Dim PasteCell As Range


Set StatusCol = Sheet2.Range("D2:D100")

For Each Status In StatusCol


    If Sheet6.Range("A2") = "" Then
        Set PasteCell = Sheet6.Range("A2")
    Else
        Set PasteCell = Sheet6.Range("A1").End(xlDown).Offset(1, 0)
    End If


    If Status = "6-2" Then Status.EntireRow.Copy PasteCell
Next Status


        
End Sub

Sub Copy2()

Dim StatusCol As Range
Dim Status As Range
Dim PasteCell As Range


Set StatusCol = Sheet2.Range("D2:D100")

For Each Status In StatusCol


    If Sheet7.Range("A2") = "" Then
        Set PasteCell = Sheet7.Range("A2")
    Else
        Set PasteCell = Sheet7.Range("A1").End(xlDown).Offset(1, 0)
    End If


    If Status = "2-10" Then Status.EntireRow.Copy PasteCell
Next Status


        
End Sub

 

[noveske]

Update: Was able to figure it out. Posting in case someone is looking for something similar.
Went with if F is not numeric.

 If cellValueD = "6-2" Then
            If IsNumeric(cellValueF) And Len(cellValueF) = 1 Then
                ' Copy row to sheet 6-2
                rngInput.EntireRow.Copy Sheet6.Cells(Sheet6.Cells(Sheet6.Rows.Count, "D").End(xlUp).Row + 1, "A")
            End If
           
        ElseIf cellValueD = "2-10" Then
            If IsNumeric(cellValueF) And Len(cellValueF) = 1 Then
                ' Copy row to sheet 2-10
                rngInput.EntireRow.Copy Sheet7.Cells(Sheet7.Cells(Sheet7.Rows.Count, "D").End(xlUp).Row + 1, "A")
            End If
           
        End If