请试试看。

Option Explicit
Sub ListObjectToWord_Multi()
    'Declare Word Variables
    Dim WrdApp As Object
    Dim WrdDoc As Word.Document
    Dim WrdTbl As Word.Table
    'Declare Excel Variables
    Dim ExcLisObj As ListObject
    Dim WrkSht As Worksheet
    Dim i As Long, bmCount As Long
    'Create a new instance of word
    Set WrdApp = CreateObject("Word.Application")
    '    Set WrdApp = GetObject(, "Word.Application")
    With WrdApp
        .Visible = True
        .Documents.Open Range("F3").Value
        Set WrdDoc = .ActiveDocument
        bmCount = WrdDoc.Bookmarks.Count
    End With
    i = 1
    'Loop through all the Worksheets in Active Workbook
    For Each WrkSht In ThisWorkbook.Worksheets
        'Loop thorugh all objects on the active sheet
        For Each ExcLisObj In WrkSht.ListObjects
            If i > bmCount Then
                MsgBox "The count of bookmarks is less than listbox."
                Exit Sub
            Else
                WrdApp.Selection.GoTo What:=wdGoToBookmark, Name:=WrdDoc.Bookmarks(i).Name
            End If
            'Paste List Objects into the word document
            With WrdApp.Selection
                .Collapse wdCollapseEnd
                ExcLisObj.Range.Copy
                'Pause the excel Application for few seconds
                ' Application.Wait Now() + TimeSerial(0, 0, 1)
                .PasteExcelTable LinkedToExcel:=True, WordFormatting:=True, RTF:=True
            End With
            'Clear my Clipboard
            Application.CutCopyMode = False
            i = i + 1
        Next
    Next
    'Go to First Page
    WrdApp.Selection.HomeKey Unit:=wdStory
End Sub

字符串