我有278个表的word文档，需要将278个表提取到不同的excel工作表中。此外，我还需要从标题描述文件中提取一个关键字来命名工作表

我在excel中有一个VBA代码，可将word文件表提取到一张excel工作表中。

  Sub ImportWordTable()

          Dim wdDoc As Object
          Dim wdFileName As Variant
          Dim tableNo As Long 'table number in Word
          Dim iRow As Long 'row index in Excel
          Dim iCol As Long 'column index in Excel
          Dim resultRow As Long
          Dim tableStart As Long
          Dim tableTot As Long
          Dim wkSht As Worksheet

  On Error Resume Next
      wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc",_
   "Browse for file containing table to be imported")

  If wdFileName = False Then Exit Sub '(user cancelled import file browser)
  Set wkSht = activeSheet
wkSht.Range("A:AZ").ClearContents

Set wdDoc = GetObject(wdFileName) 'open Word file

    With wdDoc
tableNo = wdDoc.Tables.Count
tableTot = wdDoc.Tables.Count
If tableNo = 0 Then
  MsgBox "This document contains no tables",_
    vbExclamation,"Import Word Table"
ElseIf tableNo > 1 Then
  tableNo = InputBox("This Word document contains " & tableNo & " tables." & vbCrLf & _
    "Enter the table to start from","Import Word Table","1")
End If
resultRow = 4

For tableStart = 1 To tableTot
  With .Tables(tableStart)
    'copy cell contents from Word table cells to Excel cells
    For iRow = 1 To .Rows.Count
      For iCol = 1 To .Columns.Count
        wkSht.Cells(resultRow,iCol) = WorksheetFunction.Clean(.Cell(iRow,iCol).Range.Text)
      Next iCol
      resultRow = resultRow + 1
    Next iRow
  End With
  resultRow = resultRow + 1
  With wkSht
    .Range(.Cells(resultRow,1),.Cells(resultRow,iCol)).Interior.ColorIndex = 15
  End With
  resultRow = resultRow + 1
Next tableStart
   End With

End Sub

我想修改代码，以便可以在单独的excel工作表中获取每个表。