If A2="X" and B2="Y" then copy entire row including the header row

[bwaaack]

I am trying to copy all of the rows in a sheet that meet 2 different criteria. Including the header row.
If A2="X" and B2="Y" then copy entire row including the header row

 

[DanteAmor]

I am trying to copy all of the rows in a sheet that meet 2 different criteria. Including the header row.
If A2="X" and B2="Y" then copy entire row including the header row

You only want to check A2 and B2, or also A3 and B3, A4 and B4, etc.
And where do you want to paste it?
You could explain in more detail what you need.

 

[bwaaack]

You only want to check A2 and B2, or also A3 and B3, A4 and B4, etc.
And where do you want to paste it?
You could explain in more detail what you need.

I would like to copy all rows in the sheet that meets the criteria. Then I would like to paste it into a new sheet.

 

[Trebor76]

Try this:

Option Explicit
Sub Macro1()

    Dim lngLastRow As Long
    Dim rngFiltered As Range
    Dim wsSource As Worksheet
    Dim wsOutput As Worksheet

    Application.ScreenUpdating = False
    
    Set wsSource = Sheets("Sheet1") 'Sheet name containing the data. Change to suit.
    Set wsOutput = Sheets("Sheet2") 'Sheet name for filtered data to be outputted to. Change to suit.
    
    ActiveSheet.AutoFilterMode = False 'Remove all filters
    
    'Ensure there's at least one row with a 'X' and a 'Y' in columns A and B
    If Evaluate("COUNTIF('" & wsSource.Name & "'!A:A,""X"")") + Evaluate("COUNTIF('" & wsSource.Name & "'!B:B,""Y"")") = 0 Then
        MsgBox "There are no rows with a X and Y in columns A and B!!", vbExclamation
        Exit Sub
    End If
    
    lngLastRow = wsSource.Range("A:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    With wsSource.Range("$A$1:$B$" & lngLastRow)
        .AutoFilter Field:=1, Criteria1:="X"
        .AutoFilter Field:=2, Criteria1:="Y"
        Set rngFiltered = .SpecialCells(xlCellTypeVisible)
        If Not rngFiltered Is Nothing Then
            rngFiltered.Copy Destination:=wsOutput.Range("A1")
        End If
        .AutoFilter
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox "Records have now been copied.", vbInformation

End Sub

Regards,

Robert

 

[DanteAmor]

Try this:

Sub copy_entire_row()
    Dim sh As Worksheet
        
    Set sh = Sheets("Sheet1")
    sh.Range("A1").AutoFilter 1, "X"
    sh.Range("B1").AutoFilter 2, "Y"
    Sheets.Add
    sh.AutoFilter.Range.EntireRow.Copy Range("A1")
    sh.ShowAllData
End Sub