Pdf to Excel using Word --> "wDoc.Tables.Count" not counting the empty column

[Dwolf94]

I have a code to Export/Copy Data from Pdf to Excel using Word. (I have included the code below)

So the code should create a Word file and import the selected Pdf file and copy every page as a table to word and then to excel. the code should run with in "tbindex = 0 to wDoc.Tables.Count" Range.

My problem is that the Tables in the Pdf file sometimes overflow to an extra page which leaves the first column with the "Name" empty and that results of the "wDoc.Tables.Count" not counting this page/table and resulting of the Data not being copied to excel and losing them. (see the Photo for e.g.)

does somebody knows a way or can help me including these pages also?

Many thanks in advance!

Sub readFromPDF()
    
    Dim wApp As New Word.Application
    Dim wDoc As Word.Document
    Dim pg As Word.Paragraph
    Dim wLine As String
    Dim tbCount As Integer
    Dim tbindx As Integer
    Dim lr As Long
    Dim tRow As Long, tCol As Long
    Dim xFilesToOpen As Variant
    
    Dim DataPrint As Boolean
    Dim cnt As Long
    Dim curRom As Long
    
    On Error GoTo ErrHandler
    
    Worksheets("Data").Visible = True
    Worksheets("Req").Visible = True
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    If Worksheets("Import").Range("c1").Value = "" Then
    MsgBox "Pls select a file", vbExclamation, "File Error"
    Worksheets("Import").Range("A1").Select
    Exit Sub
    End If
    
    xFilesToOpen = Worksheets("Import").Range("c1").Value
    
    Sheets("Data").Select
        Rows("1:1048576").Select
        Selection.ClearContents
        
    wApp.Visible = False
    Set wDoc = wApp.Documents.Open(xFilesToOpen, False)
        
    tbCount = wDoc.Tables.Count
    
    
    If wDoc.Tables.Count > 0 Then
    
    For tbindex = 1 To tbCount
    lr = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
    
        With wDoc.Tables(tbindex)
        
            For tRow = 1 To .Rows.Count
            lr = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
            
                For tCol = 1 To .Columns.Count
                    On Error Resume Next
                    wLine = .Cell(tRow, tCol).Range.Text
                    
                    If wLine Like "*Name*" Then
                    DataPrint = True
                    End If
                    
                    
                    If DataPrint = True Then
                    
                    Cells(lr + 1, tCol).Value = WorksheetFunction.Trim(WorksheetFunction.Clean(.Cell(tRow, tCol).Range.Text))
                    End If
                    On Error GoTo 0
                    If cnt = 5 Then
                    cnt = 0
                    lr = lr + 1
                    End If
                Next tCol
            Next tRow
                
        End With
    Next tbindex
    End If
    
    wDoc.Close
    Set wDoc = Nothing
    
    Set wApp = Nothing
    wApp.Quit
    
    Application.DisplayAlerts = True
    
    DataPrint = False
    
    Call Macro1
    Call Macro2
    Call Macro3
    
    
    'Error Handling
    ExitHandler:
        Application.ScreenUpdating = False
        Exit Sub
    ErrHandler:
        MsgBox Err.Description, , "Error Handling"
        Resume ExitHandler
        
    End Sub