excel - Copy and paste to another sheet two conditions two columns

Question

I would like to extract all row meeting the criteria in column G and z then copy to another sheet. Criteria in Column G is "Female" and Criteria in Z is >18. To be particular, I am looking to get all the females who are above 18 then copy the result to a new sheet. Here the the two macro to that I need to combine Thanks in advance

Sub CopyFemale()

    Dim c As range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet

    Set Source = ActiveWorkbook.Worksheets("Sheet1")
    Set Target = ActiveWorkbook.Worksheets("Sheet2")

    j = 1
    For Each c In Source.range("G1:G1000")
        If c = "Female" Then
           Source.Rows(c.Row).Copy Target.Rows(j)
           j = j + 1
        End If
    Next c
End Sub

    Sub CopyGreater()
    
        Dim c As range
        Dim j As Integer
        Dim Source As Worksheet
        Dim Target As Worksheet
    
        Set Source = ActiveWorkbook.Worksheets("Sheet1")
        Set Target = ActiveWorkbook.Worksheets("Sheet2")
    
        j = 1
        For Each c In Source.range("Z1:Z1000")
            If c >= 0 Then
               Source.Rows(c.Row).Copy Target.Rows(j)
               j = j + 1
            End If
        Next c
    End Sub

question from:https://stackoverflow.com/questions/65889195/copy-and-paste-to-another-sheet-two-conditions-two-columns

Answer 1

If you use AutoFilter, you could copy the entire block of data without the need to loop. Please try the following code and let me know how you go.

Option Explicit
Sub CopyFemale()
Dim Source As Worksheet, Target As Worksheet, LastRow As Long
Set Source = Sheets("Sheet1")
Set Target = Sheets("Sheet2")

With Source.Cells(1, 1).CurrentRegion
    .AutoFilter 2, "Female"
    .AutoFilter 3, ">18"
    .Copy Target.Cells(1)          ' Use this line to include headers
    '.Offset(1).Copy Target.Cells(1) ' Use this line to exclude headers
    .AutoFilter
End With

End Sub