I mostly code with Excel but i have put this togther to pull the last two tables out into Excel from Word, I tried to make it work with your button.

You can copy the whole table out in one go but you end up with strange formatting on the table when it lands in Excel, this method allows you to format the cells as you wish when the table is being created in Excel.

Hope this helps

Private Sub CommandButton1_Click()    
    Dim objDoc
    Dim iTotalCols As Long
    Dim iTotalRows As Long
    Dim iRows, iCols As Long
    Dim txt As Variant
    Dim oXL As Object
    Dim xlWB As Workbook
    Dim xlWS As Worksheet
    Dim nRows As Long
    
    Application.ScreenUpdating = False
    
    Set oXL = CreateObject("Excel.Application")
    oXL.Visible = True
    Set xlWB = oXL.Workbooks.Add
    Set xlWS = xlWB.Sheets(1)
    Set objDoc = ThisDocument


    iTotalCols = objDoc.Tables(2).Columns.Count
    iTotalRows = objDoc.Tables(2).Rows.Count
    ' get table 2 headers
    For iCols = 1 To objDoc.Tables(2).Columns.Count
        txt = objDoc.Tables(2).Cell(1, iCols).Range.Text
        With xlWS
            .Cells(1, iCols) = Replace(txt, "", "")
            .Cells(1, iCols).Font.Bold = True
        End With
    Next iCols
    ' get table 2 data
    For iRows = 2 To iTotalRows
        For iCols = 1 To iTotalCols
            With xlWS
                txt = objDoc.Tables(2).Cell(iRows, iCols).Range.Text
                .Cells(iRows, iCols) = Replace(txt, "", "")
                .Cells(iRows, iCols).Borders.LineStyle = xlContinuous
            End With
        Next iCols
    Next iRows
    ' get table 3 headers
    iTotalCols = objDoc.Tables(3).Columns.Count
    iTotalRows = objDoc.Tables(3).Rows.Count
    nRows = iRows + 2
    For iCols = 1 To objDoc.Tables(3).Columns.Count
        txt = objDoc.Tables(3).Cell(1, iCols).Range.Text
        With xlWS
            .Cells(nRows + 1, iCols) = Replace(txt, "", "")
            .Cells(nRows + 1, iCols).Font.Bold = True
        End With
    Next iCols
    ' get table 3 data
    For iRows = 2 To iTotalRows
        For iCols = 1 To iTotalCols
            With xlWS
                txt = objDoc.Tables(3).Cell(iRows, iCols).Range.Text
                .Cells(iRows + nRows, iCols) = Replace(txt, "", "")
                .Cells(iRows + nRows, iCols).Borders.LineStyle = xlContinuous
            End With
        Next iCols
    Next iRows
    xlWS.Cells.EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub