跪求大佬！

提取到一个sheet里，还是分别提取至多个sheet？

"word中的多个表格"是什么意思?
同一word文档中多个格式相同的表格? 格式不同的表格?
多个word文档中同一位置的相同格式的表格?

Sub test()
Dim wdApp As Word.Application
Dim wd As Word.Document
Dim fileName As String
Dim i As Integer '表格数量
Dim j As Integer '表格行数
Dim k As Integer '表格列数
Dim exApp As Excel.Application
Dim ex As Excel.Workbook
Dim fileName_ex As String
Dim pianyi As Integer '确定表格首行位置
fileName = "word表格内容.docx"
fileName_ex = "excel文件.xlsx"
'判断文件是否存在
If Dir(ThisDocument.Path & "\" & fileName, 16) <> Empty Then
Debug.Print "word文件存在"
Else
Debug.Print "word文件不存在,请新建文件"
End If
If Dir(ThisDocument.Path & "\" & fileName_ex, 16) <> Empty Then
Debug.Print "excel文件存在"
Else
Debug.Print "excel文件不存在,请新建文件"
End If
'实例化word应用程序,如果有正在运行的wordApplication,则调用该程序，不再新建应用程序
On Error Resume Next
If Err.Number <= 0 Then
Set wdApp = GetObject(, "Word.Application")
Else
Set wdApp = CreateObject("Word.Application")
End If
'实例化excel应用程序,如果有正在运行的excelApplication,则调用该程序，不再新建应用程序
On Error Resume Next
If Err.Number <= 0 Then
Set exApp = GetObject(, "Excel.Application")
Else
Set exApp = CreateObject("Excel.Application")
End If
'打开word文档，并赋值给wd
Set wd = wdApp.Documents.Open(ThisDocument.Path & "\" & fileName)
Set ex = exApp.Workbooks.Open(ThisDocument.Path & "\" & fileName_ex)
Word.Application.Visible = False '不显示应用程序窗体
wdApp.ScreenUpdating = False '关闭屏幕刷新
Excel.Application.Visible = False
exApp.ScreenUpdating = False
'如果word中有表格，则获取word表格数据,并赋值给excel
pianyi = 0
Debug.Print wd.Tables.Count
If wd.Tables.Count >= 1 Then
For i = 0 To wd.Tables.Count - 1
If i = 0 Then
pianyi = 0
Else
pianyi = pianyi + 1
pianyi = pianyi + wd.Tables(i).Rows.Count '偏移量等于之前所有表格的行数之和
End If
With ex.Sheets(1).Range(Cells(1 + pianyi, 1), Cells(wd.Tables(i + 1).Rows.Count + pianyi, wd.Tables(i + 1).Columns.Count)).Borders
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With ex.Sheets(1).Range(Cells(1 + pianyi, 1), Cells(wd.Tables(i + 1).Rows.Count + pianyi, wd.Tables(i + 1).Columns.Count))
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
For j = 0 To wd.Tables(i + 1).Rows.Count - 1
For k = 0 To wd.Tables(i + 1).Columns.Count - 1
ex.Sheets(1).Cells(j + 1 + pianyi, k + 1) = Replace(wd.Tables(i + 1).Cell(j + 1, k + 1).Range.text, Chr(13) & Chr(7), "")
Next k
Next j
Next i
End If
Word.Application.Visible = True
wdApp.ScreenUpdating = True
ex.Save
wd.Save
ex.Close
wd.Close
Set wdApp = Nothing
Set exApp = Nothing
Set ex = Nothing
Set wd = Nothing
Debug.Print "操作完成！"
End Sub