Extract same data-points from multiple sheets that have similar names - excel

Question

I have an excel workbook that have a subset of sheets with similar names: Data(US), Data(UK), Data(FR), Data(ES), etc... (in brackets there is the ISO code of the country which data refer to).
I would like to extract two data-points from all these sheets, and print them as a list in a new sheet to create a report.
Each sheet has the same structure inside (see here an image:
so that all the data-points are identified by coordinates for rows ("001","002", ... in row 6) and columns ("001", "002" in column D).
I am trying to write a code that does the following:
Open all sheets that have the name like: Data(**)
Inside the sheet, do a VLOOKUP to get the value corresponding to rows "001" and "002"
Print the data-points extracted in a new sheet, one after the other as a list in column D
Here is the code I wrote so far, which works only for the first sheet (Data(US)) and I included my questions as comments:
Sub ImportDataPoints()
Dim W As Worksheet, C&, F$
Dim D As String
'Take the folder path from cell D1
D = Worksheets("Input").Range("D1").Value
On Error Resume Next
'Target sheet to paste the data
Set W = ThisWorkbook.Worksheets("Data")
C = 3
Application.ScreenUpdating = False
'Open all workbooks in the folder that contain the following
F = Dir(D & "*FINANCIALDATA*" & "*.xlsx")
Do Until F = ""
C = C + 1
'Open the worksheet "Data(US)"
'### QUESTION: How to open all worksheets with similar names like Data(**)? ###
With Workbooks.Open(D & F).Worksheets("Data(US)")
'First datapoint to extract. Initial position: cell AA10.
'Do a VLOOKUP to search the value corresponding to coordinate "001"
.Range("AA10").FormulaR1C1 = "=VLOOKUP(""001"",C[-23]:C[-1],2,FALSE)"
'Move to AB10: if the previous value is empty, then give me zero
.Range("AB10").FormulaR1C1 = "=IF(RC[-1]="""",0,RC[-1])"
'Copy the value
.Range("AB10").Copy
'Paste the value in the Target sheet at row 10, column D
W.Cells(10, C).PasteSpecial xlPasteValues
'Do the same for the second datapoint and paste it in the Target sheet at row 11, column D
.Range("AA10").Offset(1, 0).FormulaR1C1 = "=VLOOKUP(""002"",C[-23]:C[-1],2,FALSE)"
.Range("AB10").Offset(1, 0).FormulaR1C1 = "=IF(RC[-1]="""",0,RC[-1])"
.Range("AB10").Offset(1, 0).Copy
W.Cells(11, C).PasteSpecial xlPasteValues
'### QUESTION: The macro should continue opening all the other sheets (Data(UK), Data(FR), Data(ES), etc...),
'### copying the datapoints 001-002 and pasting them in the same target sheet (column D, continuing from the row 11 onwards...)###
.Parent.Close False
End With
F = Dir
Loop
Set W = Nothing
Application.ScreenUpdating = True
End Sub
Does anybody know how to fix the code? Or if you can think to any other more efficient solution, all proposal are well accepted!
Many thanks in advance!

Answer 1

Something like this:
Sub ImportDataPoints()
Dim W As Worksheet, C&, F$
Dim D As String, wb As Workbook, targetRow As Long, sht As Worksheet
'Take the folder path from cell D1
D = Worksheets("Input").Range("D1").Value
'Target sheet to paste the data
Set W = ThisWorkbook.Worksheets("Data")
C = 3
Application.ScreenUpdating = False
'Open all workbooks in the folder that contain the following
F = Dir(D & "*FINANCIALDATA*.xlsx")
Do Until F = ""
C = C + 1
Set wb = Workbooks.Open(D & F)
targetRow = 10 'summary start row
For each sht in wb.worksheets
If sht.Name Like "Data(*)" Then
'....
'run your code for sheet sht
'....
targetRow = targetRow + 2 'next summary row
End With
Next sht
wb.close True
F = Dir
Loop
Set W = Nothing
Application.ScreenUpdating = True
End Sub