修改Excel VBA宏：将3个表格合并输出到单个Word文档

问题描述 #

现有Excel VBA宏用于提取被空行分隔的3个表格，原本会生成3个独立的Word文档，每个文档包含一个带分页符的格式化表格。尝试移除重复的Set wdDoc = .Documents.Add后，却只生成了第三个表格，需要修改宏实现所有表格输出到同一Word文档，同时解决表格覆盖问题。

问题根源 #

1. 原代码重复执行Set wdDoc = .Documents.Add，每次都会新建Word文档，导致生成3个独立文件。
2. 移除重复新建后，后续表格添加时未定位到文档末尾，直接覆盖了原有内容。
3. Set myTable = ActiveDocument.Tables(1)始终操作文档中的第一个表格，后续表格的边框样式未正确设置，且循环中的行号偏移逻辑错误，导致数据填充混乱。

修改后的完整VBA代码 #

Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim wdTbl As Word.Table ' 复用单个表格变量，无需三个单独变量
Dim xlSht As Worksheet
Dim lRow As Integer
Dim lCol As Integer
Dim r As Integer
Dim c As Integer
Dim Blanks As Integer
Dim First As Integer
Dim Second As Integer
Dim startRow As Integer
Dim endRow As Integer

' 获取数据总行数（排除最后2行）
lRow = Sheets("Feedback Sheets").Range("A1000").End(xlUp).Row - 2

' 定位三个表格的分隔空行位置
Blanks = 0
i = 1
Do While i <= lRow
    Set rRng = Worksheets("Feedback Sheets").Range("A" & i)
    If IsEmpty(rRng.Value) Then
        Blanks = Blanks + 1
        If Blanks = 1 Then First = i
        If Blanks = 2 Then Second = i
    End If
    i = i + 1
Loop

Set xlSht = ActiveSheet
lCol = 5 ' 列数固定为5

' 初始化Word应用，仅新建一次文档
With wdApp
    .Visible = True
    Set wdDoc = .Documents.Add
    
    ' 处理第一个表格：行1到First-1（跳过空行）
    startRow = 1
    endRow = First - 1
    ' 定位到文档末尾，准备添加新表格
    wdDoc.Range(wdDoc.Content.End - 1).Select
    Set wdTbl = wdDoc.Tables.Add(Range:=.Selection.Range, NumRows:=endRow - startRow + 2, NumColumns:=lCol)
    ' 设置表格标题
    With wdTbl
        .Rows(1).Range.Font.Bold = True
        .Rows(1).HeadingFormat = True
        .Cell(1, 1).Range.Text = "Header 1"
        If lCol > 1 Then .Cell(1, 2).Range.Text = "Header 2"
        If lCol > 2 Then .Cell(1, 3).Range.Text = "Header 3"
        ' 设置边框样式
        .Borders.InsideLineStyle = wdLineStyleSingle
        .Borders.OutsideLineStyle = wdLineStyleDouble
    End With
    ' 填充数据
    For r = startRow To endRow
        For c = 1 To lCol
            wdTbl.Cell(r - startRow + 2, c).Range.Text = xlSht.Cells(r, c).Text
        Next c
    Next r
    ' 插入分页符（第一个表格后）
    wdDoc.Characters.Last.InsertBreak Type:=wdPageBreak
    
    ' 处理第二个表格：行First+1到Second-1（跳过空行）
    startRow = First + 1
    endRow = Second - 1
    wdDoc.Range(wdDoc.Content.End - 1).Select
    Set wdTbl = wdDoc.Tables.Add(Range:=.Selection.Range, NumRows:=endRow - startRow + 2, NumColumns:=lCol)
    With wdTbl
        .Rows(1).Range.Font.Bold = True
        .Rows(1).HeadingFormat = True
        .Cell(1, 1).Range.Text = "Header 1"
        If lCol > 1 Then .Cell(1, 2).Range.Text = "Header 2"
        If lCol > 2 Then .Cell(1, 3).Range.Text = "Header 3"
        .Borders.InsideLineStyle = wdLineStyleSingle
        .Borders.OutsideLineStyle = wdLineStyleDouble
    End With
    For r = startRow To endRow
        For c = 1 To lCol
            wdTbl.Cell(r - startRow + 2, c).Range.Text = xlSht.Cells(r, c).Text
        Next c
    Next r
    ' 插入分页符（第二个表格后）
    wdDoc.Characters.Last.InsertBreak Type:=wdPageBreak
    
    ' 处理第三个表格：行Second+1到lRow（跳过空行）
    startRow = Second + 1
    endRow = lRow
    wdDoc.Range(wdDoc.Content.End - 1).Select
    Set wdTbl = wdDoc.Tables.Add(Range:=.Selection.Range, NumRows:=endRow - startRow + 2, NumColumns:=lCol)
    With wdTbl
        .Rows(1).Range.Font.Bold = True
        .Rows(1).HeadingFormat = True
        .Cell(1, 1).Range.Text = "Header 1"
        If lCol > 1 Then .Cell(1, 2).Range.Text = "Header 2"
        If lCol > 2 Then .Cell(1, 3).Range.Text = "Header 3"
        .Borders.InsideLineStyle = wdLineStyleSingle
        .Borders.OutsideLineStyle = wdLineStyleDouble
    End With
    For r = startRow To endRow
        For c = 1 To lCol
            wdTbl.Cell(r - startRow + 2, c).Range.Text = xlSht.Cells(r, c).Text
        Next c
    Next r
End With

' 释放对象
Set wdTbl = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing
Set xlSht = Nothing

关键修改点说明 #

• 仅新建一次Word文档：移除重复的Set wdDoc = .Documents.Add，全程复用同一个文档对象。
• 定位文档末尾添加表格：每次添加新表格前，通过wdDoc.Range(wdDoc.Content.End - 1).Select将光标移到文档末尾，避免覆盖已有内容。
• 修正数据行偏移逻辑：使用startRow和endRow明确每个表格的Excel数据范围，通过r - startRow + 2计算Word表格的目标行（1行是标题，所以从第2行开始填充数据）。
• 直接设置当前表格边框：不再依赖ActiveDocument.Tables(1)，而是对刚新建的wdTbl对象直接设置边框样式，确保每个表格都能正确应用格式。
• 跳过分隔空行：原代码会把空行也加入表格，修改后通过startRow = First + 1跳过空行，确保表格数据都是有效内容。
• 调整分页符位置：只在第一个和第二个表格后插入分页符，避免最后一个表格后出现多余空白页。

内容的提问来源于stack exchange，提问作者d wattam