サンプルコード

Sub ExcelにSQLをかける()
    Dim adoCN As Object
    Dim adoRS As Object
    
    Dim strBookPath As String
    Dim wb As Workbook
    Dim lastRow As Long
    
    Dim arMaster As Variant
    Dim arKeySet As Variant
    
    Dim i As Long
    
    Dim str_条件1 As String
    Dim str_条件2 As String
    Dim str_SQL As String
          
    '
    Set adoCN = CreateObject("ADODB.Connection")
    Set adoRS = CreateObject("ADODB.Recordset")
        
    'マスタを取得
    With Sheets("マスタ")
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        arMaster = .Range(Cells(2, 1), Cells(lastRow, 2))
    End With
    
    'Excelのパスを設定
    strBookPath = "C:\Users\デスクトップ\ExcelVBAプロジェクト\SQLをかける\test.xlsx"
    'ワークブックオブジェクトを取得
    Set wb = Workbooks.Open(strBookPath)
        
    'ADOでExcelに接続
    adoCN.Open = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source=" & strBookPath & ";" & _
                "Extended Properties='Excel 12.0;HDR=YES'"
                
    'マスタの最後まで繰り返し（2行で1セットの為、2つおきにスキップ）
    For i = 1 To UBound(arMaster) Step 2
    
        'マスタより条件文言を取得
        arKeySet = fncGetMaster(arMaster, i)
        str_条件1 = arKeySet(0)
        str_条件2 = arKeySet(1)
        
        '条件を指定してSQL文を発行
        str_SQL = "SELECT * FROM [Sheet1$] WHERE 購入品名 IN('" & str_条件1 & "','" & str_条件2 & "') ORDER BY 単価"
                              
        Debug.Print str_SQL
                
        Set adoRS = adoCN.Execute(str_SQL)
               
        'シート内の貼り付け基点セルを特定
        wb.Sheets("Sheet2").Select
        If i = 1 Then
            lastRow = 2
        Else
            lastRow = wb.Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
        End If
        
        'SQLで抽出し並び変えたデータをSheet2に貼り付け
        wb.Sheets("Sheet2").Select
        wb.Sheets("Sheet2").Range("A" & CStr(lastRow + 1)).CopyFromRecordset Data:=adoRS
        
        'レコードセットを初期化
        adoRS.Close
        Set adoRS = Nothing
    Next
    
    wb.Save
    wb.Close True
                   
    adoRS.Close: adoCN.Close
    Set adoRS = Nothing: Set adoCN = Nothing
    
End Sub

Function fncGetMaster(arr As Variant, intNum As Long) As Variant
'-------------------------------------------------------
'機能：SQLで絞り込み後のマスタテーブルより条件１と条件2
'　　　の文言を取得する
'引数1：絞り込み後マスタテーブルを格納したオブジェクト
'引数2:マスタテーブルの該当行
'戻り値：条件1と条件2を格納したオブジェクト
'-------------------------------------------------------
    Dim i As Long
    Dim j As Integer
    Dim strTemp As String
    Dim result(1) As String
    
    i = 1
    j = 0

    For i = intNum To intNum + 1
        strTemp = arr(i, 1)
        result(j) = strTemp
        j = j + 1
    Next
    
    fncGetMaster = result
    
End Function