VBA cellextract for multiple xlsx files returning runtime error 9 - vba

Question

At work, I receive a large number of PDF forms. Entry into the forms occurs in a table within the PDF. Specific entries in the PDF must be entered into an Excel sheet (referred to as the tracker from now on). It's very tedious to add each entry. This method is also prone to error.
I then determined that I could turn each PDF into a .xlsx file, keeping the table format. With cells to reference, I made a VLOOKUP formula to extract the exact info I needed for the tracker. I simply had to copy/paste the table range from the newly created converted .xlsx into my VLOOKUP extractor .xlsx, and the needed info would populate for me to paste into the tracker.
However, using this method, I would still need to convert multiple PDFs to .xlsx, open them one by one, paste the table into my extractor .xlsx, and then copy and paste the new extracted data into the tracker. So, still not quite efficient. I determined that I needed a macro.
The macro I found should loop through .xlsx files in a specified folder, opening them and searching for indicated cells. As you can see in the below macro, the cells aren't in any one range. I must extract values from specific cells.
Next, it should extract the values from the indicated cells and populate them as instructed in the sheet the macro was ran from.
However, I keep getting 'run-time error 9 subscript out of range' no matter what I do. Debug points to the following line of code as the reason for the error 9: Set OpenWorksheet = OpenWorkbook.Worksheets(SheetName)
I tried replacing SheetName in the offending line with Table1 only to get the same error. Tried Sheet1 but then get a run-time error 13.
I've been searching the net for a few hours, but I can't quite find a case similar to mine. Any help would be appreciated.
Macro is as follows:
Sub ExtractCells()
' local wb vars
Dim wb As Workbook
Dim ws As Worksheet
Dim MySheet As String
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim r4 As Range
Dim r5 As Range
Dim r6 As Range
Dim r7 As Range
Dim r8 As Range
Dim r9 As Range
Dim r10 As Range
Dim r11 As Range
Dim r12 As Range
Dim i As Integer
' opened wb vars
Dim OpenWorkbook As Workbook
Dim OpenWorksheet As Worksheet
Dim SheetName As String
' looping params
Dim Directory As String
Dim FileSpec As String
Dim MyFile As String
' define looping params
Directory = "C:\MultiPD Test\Forms\" 'CHANGE THIS
FileSpec = ".xlsx" 'CHANGE THIS IF NECESSARY
MyFile = Dir(Directory & "*" & FileSpec)
SheetName = "Table1" 'CHANGE THIS
' set local vars
Set wb = ThisWorkbook
MySheet = "Sheet1" 'CHANGE THIS
Set ws = wb.Worksheets(MySheet)
' This is where data will begin to write
Set r1 = ws.Range("A1")
Set r2 = ws.Range("B1")
Set r3 = ws.Range("C1")
Set r4 = ws.Range("D1")
Set r5 = ws.Range("E1")
Set r6 = ws.Range("F1")
Set r7 = ws.Range("G1")
Set r8 = ws.Range("H1")
Set r9 = ws.Range("I1")
Set r10 = ws.Range("J1")
Set r11 = ws.Range("K1")
Set r12 = ws.Range("L1")
i = 0
' If there is one thing you take away from this, it should be the construct below i.e. how to loop through files
Do While MyFile <> ""
Set OpenWorkbook = Application.Workbooks.Open(Filename:="C:\MultiPD Test\Forms\*.xlsx", ReadOnly:=True)
Set OpenWorksheet = OpenWorkbook.Worksheets(SheetName)
' write data down col
With OpenWorksheet
r1.Offset(i, 0).Value = .Range("C4").Value
r2.Offset(i, 0).Value = .Range("C6").Value
r3.Offset(i, 0).Value = .Range("C8").Value
r4.Offset(i, 0).Value = .Range("C10").Value
r5.Offset(i, 0).Value = .Range("C12").Value
r6.Offset(i, 0).Value = .Range("C15").Value
r7.Offset(i, 0).Value = .Range("C16").Value
r8.Offset(i, 0).Value = .Range("C22").Value
r9.Offset(i, 0).Value = .Range("C35").Value
r10.Offset(i, 0).Value = .Range("C36").Value
r11.Offset(i, 0).Value = .Range("C37").Value
r12.Offset(i, 0).Value = .Range("C38").Value
End With
i = i + 1
MyFile = Dir
Loop
End Sub

Answer 1

As mentioned in the comments:
The first line that should throw Run-time error 1004: file "..." could not be found is this:
Application.Workbooks.Open(Filename:="C:\MultiPD Test\Forms\*.xlsx", ReadOnly:=True)
The next issue is that "Table1" is not a valid sheet name (it seems to be a ListObject name)
Once all sheets from the .XLSX files were renamed to Sheet1 your code works
The version bellow uses an array to reduce repetiton:
Option Explicit
Public Sub ExtractCellsFromMultiFiles()
Const SRC_COL = 3
Dim thisWS As Worksheet, wsName As String, srcRows As Variant
Dim foldr As String, srcFile As String, ext As String
srcRows = Array(4, 6, 8, 10, 12, 15, 16, 22, 35, 36, 37, 38)
wsName = "Sheet1" 'Not "Table1", which is probably a ListObject Table name
Set thisWS = ThisWorkbook.Worksheets(wsName)
foldr = "C:\MultiPD Test\Forms\"
ext = ".xlsx"
srcFile = Dir(foldr & "*" & ext)
Dim srcWB As Workbook, srcWS As Worksheet, i As Long, j As Long
i = 1
Application.ScreenUpdating = False
Do While Len(srcFile) > 0
Set srcWB = Workbooks.Open(Filename:=foldr & srcFile, ReadOnly:=True)
Set srcWS = srcWB.Worksheets(wsName)
For j = 1 To UBound(srcRows) + 1
thisWS.Cells(i, j).Value2 = srcWS.Cells(srcRows(j - 1), SRC_COL).Value2
Next
i = i + 1
srcWB.Close False
srcFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
Output:
ColA ColB ColC ColD ColE ColF ColG ColH ColI ColJ ColK ColL
----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
S1C4 S1C6 S1C8 S1C10 S1C12 S1C15 S1C16 S1C22 S1C35 S1C36 S1C37 S1C38
S2C4 S2C6 S2C8 S2C10 S2C12 S2C15 S2C16 S2C22 S2C35 S2C36 S2C37 S2C38
S3C4 S3C6 S3C8 S3C10 S3C12 S3C15 S3C16 S3C22 S3C35 S3C36 S3C37 S3C38