学习Excel技术，关注微信公众号：
excelperfect
实例场景
有些时候，需要将多个Excel表复制到Word文档中指定的位置。一般可以使用通常的复制/粘贴操作，然而如果表很多的话，VBA就派上用场了。
演示数据
我们准备了3个表，如下图1至图3所示。
图1
图2
图3
准备工作
我们需要将这3个表插入到名为“Excel报表.docx”的Word文档中。因为要分别插入到文档中指定位置，所以我们在要插入的位置定义书签。将光标放置到要插入表的位置，单击功能区“插入”选项卡“链接”组中的“书签”，输入书签名，单击“添加”按钮，如下图4所示。
图4
由于要插入3个表，因此在要插入的位置添加3个书签。在本例中，我们将3个书签分别命名为“书签1”、“书签2”和“书签3”。
在VBA编辑器中，单击“工具——引用”，找到并选取“Microsoft Word 16.0 Object Library”前的复选框，如下图5所示。
图5
代码
在VBA编辑器中，插入一个新模块，输入下面的代码：
代码语言：javascript复制'强制数组下标以1开始
Option Base 1
'将Excel表复制到一个新的Word文档
Sub ExcelTablesToWord()
Dim rngTable As Excel.Range
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table
Dim varTableArray As Variant
Dim varBookmarkArray As Variant
Dim i As Integer
'要复制的Excel表的表名
varTableArray = Array("表1", "表2", "表3")
'要粘贴到Word文档的书签名
varBookmarkArray = Array("书签1", "书签2", "书签3")
'关闭屏幕更新和事件
Application.ScreenUpdating = False
Application.EnableEvents = False
'将变量赋值给目标Word文档
On Error GoTo NotFoundWordDoc
Set WordApp = GetObject(Class:="Word.Application")
WordApp.Visible = True
Set myDoc = WordApp.Documents("Excel报表.docx")
On Error GoTo 0
'遍历并粘贴Excel表
For i = LBound(varTableArray) To UBound(varTableArray)
'从Excel中复制表区域
Set rngTable = ThisWorkbook.Worksheets(i).ListObjects(varTableArray(i)).Range
rngTable.Copy
'将表粘贴到Word
myDoc.Bookmarks(varBookmarkArray(i)).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False
'自动调整表以适应Word文档
Set WordTable = myDoc.Tables(i)
WordTable.AutoFitBehavior (wdAutoFitWindow)
Next i
'给出消息
MsgBox "复制完成!", vbInformation
GoTo EndRoutine
'错误处理
NotFoundWordDoc:
MsgBox "Word文件'Excel报表.docx'未打开,重试.", 16
EndRoutine:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.CutCopyMode = False
End Sub运行代码，结果如下图6所示。
图6
应用小结
1.在Word中使用书签功能进行定位，并在代码中利用书签，是一种常用的技巧。
2.使用数组并将表名与书签名相对应，能够极大地方便代码的编写。
3.对Excel数据和Word文档进行合适的设置，能够很好地帮助数据处理。
欢迎在下面留言，完善本文内容，让更多的人学到更完美的知识。
欢迎到知识星球：完美Excel社群，进行技术交流和提问，获取更多电子资料。
