Matching the Three Criteria and Copy Paste the Data - excel

Question

Below code match the string in the specific range (this range contains Headers) if finds then copy the whole column and paste into Sheet2.
I want to add two more condition in below code that are:
Dim FindValue2 As String
Dim FindValue3 As String
FindValue2 = shSummary.Range("A2").Value
FindValue3 = shSummary.Range("B2").Value
and match in Sheet1 Column A for FindValue3 and Column F for FindValue2 after matching these 3 criteria then copy and paste the data.
Your help will be much appreciated.
Sub find()
Dim foundRng As Range
Dim FindValue As String
Dim lastRow As Long
Set shData = Worksheets("Sheet1")
Set shSummary = Worksheets("Sheet2")
FindValue = shSummary.Range("C2")
Set foundRng = shData.Range("G1:Z1").find(FindValue)
With shData
lastRow = .Cells(.Rows.Count, foundRng.Column).End(xlUp).Row
End With
shData.Rows("2:" & lastRow).Columns(foundRng.Column).Copy shSummary.Range("I3")
End Sub

Answer 1

Apply a filter to columns A and F then copy the visible cells.
Option Explicit
Sub Find3()
Dim wb As Workbook, wsData As Worksheet, wsSummary As Worksheet
Dim rngFound As Range, rngData As Range, rngCopy As Range
Dim FindValue As String, FilterA As String, FilterF As String
Dim lastRow As Long, c As Long
Set wb = ThisWorkbook
Set wsData = wb.Worksheets("Sheet1")
wsData.AutoFilterMode = False
Set wsSummary = wb.Worksheets("Sheet2")
With wsSummary
FindValue = .Range("B2")
FilterA = .Range("C2")
FilterF = .Range("A2")
End With
Set rngFound = wsData.Range("G1:Z1").find(FindValue)
If rngFound Is Nothing Then
MsgBox "'" & FindValue & "' not found", vbCritical
Exit Sub
End If
' column matching FindValue
c = rngFound.Column
lastRow = wsData.Cells(Rows.Count, c).End(xlUp).Row
If lastRow = 1 Then
MsgBox "No data in column " & c, vbCritical
Exit Sub
End If
' filter data on colA and F
With wsData
Set rngData = .Cells(2, c).Resize(lastRow - 1)
.UsedRange.AutoFilter
.UsedRange.AutoFilter Field:=1, Criteria1:=FilterA
.UsedRange.AutoFilter Field:=6, Criteria1:=FilterF
' data to copy
On Error Resume Next
Set rngCopy = rngData.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
' copy data
If rngCopy Is Nothing Then
MsgBox "No data to copy from column " & c, vbCritical
.AutoFilterMode = False
Exit Sub
Else
rngCopy.Copy wsSummary.Range("I3")
End If
.AutoFilterMode = False
End With
MsgBox "Done"
End Sub

Answer 2

Copy Data Columns to Another Worksheet
Adjust the values in the constants section.
Delete (out-comment) the Debug.Print lines when done testing.
Option Explicit
Sub ExportDataColumns()
Const sName As String = "Sheet1"
Const sHeadersAddress As String = "G1:Z1"
Const dName As String = "Sheet2"
Const dReadList As String = "A2,B2,C2"
Const dWriteList As String = "F3,A3,I3"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim wsrCount As Long: wsrCount = sws.Rows.Count
Dim shrg As Range: Set shrg = sws.Range(sHeadersAddress)
Debug.Print "Source Header Range: " & shrg.Address(0, 0)
Dim sfRow As Long: sfRow = shrg.Row + 1 ' first row below the headers
Debug.Print "Source First Row: " & sfRow
If sfRow >= wsrCount Then Exit Sub
Dim slRow As Long: slRow = GetLastRow(shrg)
Debug.Print "Source Last Row: " & slRow
If slRow < sfRow Then Exit Sub
Dim sdrg As Range
Set sdrg = shrg.Resize(slRow - sfRow + 1).Offset(1)
Debug.Print "Source Data Range: " & sdrg.Address(0, 0)
Dim dRead() As String: dRead = Split(dReadList, ",")
Dim dWrite() As String: dWrite = Split(dWriteList, ",")
Dim dUpper As Long: dUpper = UBound(dRead)
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
Dim srg As Range
Dim drg As Range
Dim dcrg As Range
Dim srCount As Long
Dim n As Long
For n = 0 To dUpper
Debug.Print "Item " & n + 1
Dim scIndex As Variant
scIndex = Application.Match(dws.Range(dRead(n)).Value, shrg, 0)
If IsNumeric(scIndex) Then
Set srg = sdrg.Columns(scIndex)
Debug.Print "Source Range: " & srg.Address(0, 0)
srCount = srg.Rows.Count
Set drg = dws.Range(dWrite(n)).Resize(srCount)
Debug.Print "Destination Range: " & drg.Address(0, 0)
drg.Value = srg.Value
Set dcrg = drg.Resize(wsrCount - drg.Row - srCount + 1) _
.Offset(srCount)
Debug.Print "Destination Clear Range: " & dcrg.Address(0, 0)
dcrg.ClearContents
End If
Next n
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the worksheet row number of the last non-empty row
' in the range from the first row of a range ('rg')
' through the same sized bottom-most row of the worksheet.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetLastRow( _
ByVal rg As Range) _
As Long
If rg Is Nothing Then Exit Function
Dim lCell As Range
With rg.Rows(1)
Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , xlByRows, xlPrevious)
End With
If lCell Is Nothing Then Exit Function
GetLastRow = lCell.Row
End Function