VBA宏：将Excel中的带格式表格粘贴到Word中

        如题，就是用VBA实现了从Excel到Word的复制粘贴操作，因为我有720张储存在4个Excel中的表格需要粘贴到30个Word文档中。

        注释非常详细，如果需要使用，还是需要自己做修改的，路径啊，循环什么的……

        如果你有特定需求但是自己不会写可以联系我，邮箱在文尾。      

        我发现没有任何代码基础的人是不会看这些代码的，更不会看注意事项，所以我把注意事项也放文末。

       上一次的Excel到Excel的复制粘贴其实也是为了解决这个问题，当时学了很长时间没找到解决方案，因为我发现我无法实现Excel与Word的通信，最近发现我可以用Excel的宏创建一个Word应用程序对象，于是问题就迎刃而解了。

Sub ExportSheetsToWord()
    Dim wdApp As Object     ' 定义一个对象，之后用来指代Word应用程序
    Dim wdDoc As Object     ' 定义一个对象，之后用来指代Word文档
    Dim i As Integer, j As Integer      ' 定义两个整型变量用于控制循环
    Dim sheetCount As Integer       ' 定义一个整形变量用于计数
    ' 定义我的四个工作表对象
    Dim wsA As Worksheet, wsB As Worksheet, wsC As Worksheet, wsD As Worksheet
    ' 定义我的四个工作簿对象
    Dim wbA As Workbook, wbB As Workbook, wbC As Workbook, wbD As Workbook

    ' 打开四个Excel文件
'     Set wbA = Workbooks.Open("C:/Users/Administrator/Desktop/A.xlsx")
'     Set wbB = Workbooks.Open("C:/Users/Administrator/Desktop/B.xlsx")
'     Set wbC = Workbooks.Open("C:/Users/Administrator/Desktop/C.xlsx")
'     Set wbD = Workbooks.Open("C:/Users/Administrator/Desktop/D.xlsx")
    ' 我的文件已经打开了，所以不再打开
    Set wbA = Workbooks("A.xlsx")
    Set wbB = Workbooks("B.xlsx")
    Set wbC = Workbooks("C.xlsx")
    Set wbD = Workbooks("D.xlsx")
    ' 创建Word应用
    Set wdApp = CreateObject("Word.Application")
    ' 隐藏Word窗口，可以提高处理速度
    wdApp.Visible = False

    For i = 1 To 30     ' 30个文件
        ' 创建新的Word文档
        Set wdDoc = wdApp.Documents.Add
        For j = 1 To 6      ' 每个文件中要粘贴6次，每次粘贴4个表格
            ' 添加分割文本
            With wdDoc.Content
                .InsertAfter "表格" & (j) & vbCrLf
                .Font.Name = "黑体"
                .Font.Size = 12 ' 四号字
                .Paragraphs.Alignment = 1 ' 居中对齐
            End With
            wdApp.Selection.EndKey Unit:=6 ' 移动光标到文档末尾
            wdApp.Selection.TypeParagraph ' 插入换行

            sheetCount = (i - 1) * 6 + j        ' 工作表计数
            If sheetCount > 180 Then Exit For

            Set wsA = wbA.Worksheets(sheetCount)        ' 按工作表计数索引工作表
            wsA.UsedRange.Copy                          ' 复制工作表的所有内容
            ' 使用 Selection 粘贴到文档末尾
            wdApp.Selection.EndKey Unit:=6 ' 移动光标到文档末尾
            wdApp.Selection.Paste                        ' 粘贴到文档中
            wdApp.Selection.TypeParagraph ' 插入换行
            wdApp.Selection.TypeParagraph ' 插入换行

            Set wsB = wbB.Worksheets(sheetCount)
            wsB.UsedRange.Copy
            ' 使用 Selection 粘贴到文档末尾
            wdApp.Selection.EndKey Unit:=6 ' 移动光标到文档末尾
            wdApp.Selection.Paste
            wdApp.Selection.TypeParagraph ' 插入换行
            wdApp.Selection.TypeParagraph ' 插入换行

            Set wsC = wbC.Worksheets(sheetCount)
            wsC.UsedRange.Copy
            ' 使用 Selection 粘贴到文档末尾
            wdApp.Selection.EndKey Unit:=6 ' 移动光标到文档末尾
            wdApp.Selection.Paste
            wdApp.Selection.TypeParagraph ' 插入换行
            wdApp.Selection.TypeParagraph ' 插入换行

            Set wsD = wbD.Worksheets(sheetCount)
            wsD.UsedRange.Copy
            ' 使用 Selection 粘贴到文档末尾
            wdApp.Selection.EndKey Unit:=6 ' 移动光标到文档末尾
            wdApp.Selection.Paste
            wdApp.Selection.TypeParagraph ' 插入换行
            wdApp.Selection.TypeParagraph ' 插入换行
        Next j
        wdDoc.SaveAs "AAAAAA" & i & ".docx"                 ' 保存
        wdDoc.Close
    Next i
    wdApp.Quit
End Sub

        注意事项：

        1.运行过程中不要动键盘和鼠标。这一点很重要。

        2.运行前请关闭你的其他软件。这一点也很重要。

        3.如果你没看前两点就去运行了，你应该会回来看第三点，第三点用来给你解释前两条的原因，VBA是微软家的，运行过程中除了调用Excel和Word程序，也调用了Windows上的一些东西，我不知道这些东西是什么，我要是知道我就去微软当工程师了，然后调用Windows上的这些东西就导致了，当你动键鼠时输入的指令会干扰VBA的运行，你的其他程序占用Windows资源会导致VBA无法顺利调用Windows的某些功能，从而报错。

        邮箱：lian@henu.edu.cn