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