Lookup from and loop through workbooks and copy value if there is a match to main workbook to main workbook - vba

Question

I want to automatize a process which requires me looking up up to 20 workbooks and copying a cell if another cell is matching with the main workbook. I want to create something similar to Excel's built-in lookup function but is has to handle and loop through multiple workbooks. I've uploaded a screenshot which shows how the sheet ("Basis") in the main workbook looks like and an example of one of the sheets ("Report") that I copy the cell value from. The workbooks that contain the Report sheets (one sheet for every workbook) are stored in a folder locally.
So far I've tried to keep it simple by starting with one "Report Workbook" and then trying to copy the value over to the main workbook. This is how I want the logic to be: If there is a match between cell B10 (highlighted in red) in the reports sheet and one of the cells in range I4:I19 (highlighted in green), then the value in cell F13 should be copied in the Index column (highlighted in yellow), otherwise don't do anything. Loop and repeat procedure with every workbook in the folder.
In this particular case, there is a match for "200S", which means that the value 105 in cell F13 should be copied in cell L18. (Notice, that multiple routes can be in the same cell separated with a comma (just like here).
This is my code so far, and it works but I want it to loop through several workbooks in a fixed folder:
Sub CopyLookup()
Dim rng1 As Range, c1 As Range, rng2 As Range, c2 As Range
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lnLastRow1 As Long, lnLastRow2 As Long
'Create an object for each worksheet:
Set ws1 = Worksheets("Report")
Set ws2 = Worksheets("Basis")
'Get the row number of the last cell containing data in the basis sheet:
lnLastRow2 = ws2.Cells(ws2.Cells.Rows.Count, "A").End(xlUp).Row
'Create range objects for the two columns to be compared:
Set rng1 = ws1.Range("B10")
Set rng2 = ws2.Range("I4:I19")
'Loop through each cell in col I in sheet 2:
For Each c2 In rng2
'Check if the cell is not blank:
If c2.Value <> "" Then
'Loop through each cell in cell B10 in other sheet:
For Each c1 In rng1
'Test if cells match:
If c1.Value = c2.Value Then
'Copy value from sheet 1 to sheet 2 (main workbook):
c2.Offset(0, 3).Value = c1.Offset(3, 4).Value
'Move on to next cell in sheet 2:
Exit For '(exits the "For Each c1 In rng1" loop)
End If
Next c1
End If
Next c2
End Sub
The code has to be modified to handle separate workbooks (and not one workbook as it is done at the moment) and loop through several workbooks in the folder and compare them to the main workbook where the values are copied over.

Answer 1

I'm just giving you an example how to loop through the report Files.
This Code should be in the Basis Workbook. It Loops Through the RootFolder and adds all Files matching the Report.xslx File Pattern in the File Variable. Modify this as needed.
Dim File As Variant
Dim fileList As Collection
Dim RootFolder As String
Set fileList = New Collection
'Path of Folder to search for Reportfiles
RootFolder = "C:\Example\Path\"
'Modify *Report*.xlsx to match your Report File Names
File = Dir(RootFolder & "*Report*.xlsx")
'Loop Through all Report files
While File <> ""
'Add File to Collection
fileList.Add RootFolder & File
File = Dir
Wend
Dim FilePath As Variant
Dim objBasis As Workbook
Dim objReport As Workbook
'Set BasisFile
Set objBasis = ThisWorkbook
'Loop Through Report Files
For Each FilePath In fileList
'Open Workbook
Set objReport = Workbooks.Open(FilePath)
'#######################################################
'PASTE YOUR CODE HERE
'Example To access Values from Sheet in ReportFile
Debug.Print objReport.Sheets("Report").Cells(1, 1).Value
'#######################################################
'Close ReportFile without saving
objReport.Close False
Next FilePath