SELECT * FROM [Дата$] WHERE [Код продукта] = 440

Sub SQLconn()
    Set objConnection = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & ActiveWorkbook.Path & "\" & ActiveWorkbook.Name & ";" & _
    "Extended Properties=""Excel 12.0;HDR=NO"";"
    sqlStr1 = "SELECT D.F1, D.F2, AD.F10, D.F80 FROM [Data$A11:CB20] AS D LEFT JOIN [AnotherData$C1:L3] AS AD ON D.F2 = AD.F1 WHERE D.F1 = 440"
    rs.Open sqlStr1, objConnection, 3, 3
    Sheets("Foto").Cells(2, 1).CopyFromRecordset rs
 End Sub

Sub certain_ID_dic()
Dim a(), i&, lr&
With Sheets("Data")
    lr = .Cells(.Rows.Count, "A").End(xlUp).Row
    a = .Range("a11:cb" & lr).Value
End With

    With CreateObject("Scripting.Dictionary")
        '.CompareMode = 1    ' если в массиве только числа, то можно без этой строки
        For i = 1 To UBound(a)
   'условие на конкретный ID
        If a(i, 1) = 440 Then      
            ID = a(i, 1)
   'сбор ключей и значений под каждый ключ
            If Not .exists(a(i, 2)) Then .Item(a(i, 2)) = a(i, UBound(a, 2))
        End If
        Next i
   'выгрузка
        Sheets("Foto").Range("B2").Resize(.Count, 1).Value = Application.Transpose(Array(.keys))
        Sheets("Foto").Range("E2").Resize(.Count, 1).Value = Application.Transpose(Array(.items))
        Sheets("Foto").Range("A2").Resize(.Count, 1).NumberFormat = "000000"
        Sheets("Foto").Range("A2").Resize(.Count, 1).Value = ID
    End With
End Sub

    'проходим по всем выбранным файлам
    x = 1
    While x <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
        'выполняем свой код
   'нужное вставляем в первую строку после последней заполненной в Thisworkbook
        x = x + 1
    Wend