VBA double-loop search and copy

Hi, I didnt open up your files, but i think i understand what your looking for.

this should help point you in the right direction if nothing else. ( there might be a little bit of additional data that you don't need. i tried to remove it all but i pulled this from one of my old codes.)

let me know if it works

Sub Transfer_data_from_Files()

Dim MyPath, MyFileName, MyFolderName
Dim PATHandFILE, FExist, MyCount, FCount, MySheet


'****************************************************************
' set path to folders

MyPath = "C:\Users\*your user name*\Desktop\Myfolder"     ' be sure to change the username and the folder where your files are (do not put the main one in same folder)

MyFileName = Dir(MyPath & "\")


'****************************************************************
'count files with in dir

Do While MyFileName <> ""
       MyCount = MyCount + 1
        MyFileName = Dir()
Loop

FCount = MyCount
MyCount = 0

'****************************************************************
'set first file name

MyFileName = Dir(MyPath & "\")


'****************************************************************
' loop throw each file copy the data

Do While MyFileName <> ""
   PATHandFILE = MyPath & MyFileName
   
    Workbooks.Open Filename:=PATHandFILE
    Workbooks(MyFileName).Activate
    
   For MySheet = 1 To Workbooks(MyFileName).Sheets.Count
        Workbooks(MyFileName).Sheets(MySheet).Range("D1").Copy
        
        ThisWorkbook.Activate
        
        MyRow = Sheet1.Range("A99999").End(xlUp).Row + 1
        Sheet1.Cells(MyRow, 1).Select
        Sheet1.Cells(MyRow, 1).PasteSpecial
    Next
        
    Application.DisplayAlerts = False
    Workbooks(MyFileName).Close
    Application.DisplayAlerts = True
    
    
    MyCount = MyCount + 1
  
    
    
   MyFileName = Dir()

Loop


End Sub

Hi here is what you need:

Option Explicit
Sub doubleLoop()
Dim c As Range, c2 As Range
Dim strFileName As String, Path As String
Dim strIncrFileName As String, strIncrWksName As String
Dim wks As Worksheet, wksTmp As Worksheet
Dim wkbTmp As Workbook

For Each c In ThisWorkbook.Worksheets("YahBoh").Range("B1:D1") 'Loops through the files names increments

    strIncrFileName = "Yadayada" + CStr(c) + "*" '* will work for any format
    Path = "C:\Users\stagiaire\Desktop\Forums questions\" 'PLUG YOUR PATH HERE
    strFileName = Dir(Path & strIncrFileName) 'Gets the file name
    
    If strFileName <> vbNullString Then 'If a file has been found
    
        For Each c2 In ThisWorkbook.Worksheets("YahBoh").Range("A2:A4") 'Loops through the worksheets names increments
            
            Set wkbTmp = Workbooks.Open(Path & strFileName, , True) 'Opens and sets the temporary workbook read-only
            
            strIncrWksName = c2
            
            Set wksTmp = wkbTmp.Worksheets(strIncrWksName)
            
            ThisWorkbook.Worksheets("YahBoh").Cells(c2.Row, c.Column) = wksTmp.Range("$D$1")
                            
        Next
        
        wkbTmp.Close False 'Closes the temporary workbook without saving
        
    End If
    
Next

End Sub

It works with the examples sheets you provided, you just have to replace the names, path and ranges accordingly to your needs.