Excel VBA生成MS Word多表格问题：表格被覆盖而非依次显示

原代码生成Word表格时会重复覆盖，核心问题是表格插入位置错误，每次都在文档起始区域插入，导致新表格替换旧表格。以下是修复后的代码，实现表格依次排列并保留间距：

Sub ExportToWord()
    Dim objWordApp As Object
    Dim objWordDoc As Object
    Dim objExcelSheet As Worksheet
    Dim objTable As Object
    Dim lastRow As Long, lastColumn As Long
    Dim i As Long, j As Long
    
    ' 启动Word应用并新建文档
    Set objWordApp = CreateObject("Word.Application")
    objWordApp.Visible = True
    Set objWordDoc = objWordApp.Documents.Add
    
    ' 指定要导出的Excel工作表
    Set objExcelSheet = ThisWorkbook.Sheets("Sheet1")
    
    ' 获取A列最后一行数据行号
    lastRow = objExcelSheet.Cells(objExcelSheet.Rows.Count, "A").End(xlUp).Row
    ' 获取第一行最后一列数据列号
    lastColumn = objExcelSheet.Cells(1, objExcelSheet.Columns.Count).End(xlToLeft).Column
    
    ' 循环生成「A列+第i列」的表格
    For i = 2 To lastColumn
        ' 定位插入位置到文档末尾，避免覆盖已有内容
        Dim insertRange As Object
        Set insertRange = objWordDoc.Content.End
        
        ' 在文档末尾插入新表格（行数=数据行数，列数=2）
        Set objTable = objWordDoc.Tables.Add(insertRange, lastRow, 2)
        
        ' 填充表格数据
        For j = 1 To lastRow
            objTable.Cell(j, 1).Range.Text = objExcelSheet.Cells(j, 1).Text
            objTable.Cell(j, 2).Range.Text = objExcelSheet.Cells(j, i).Text
        Next j
        
        ' 在表格后插入空段落，增加表格间距
        objWordDoc.Content.End.InsertParagraphAfter
    Next i
    
    ' 释放对象
    Set objTable = Nothing
    Set objWordDoc = Nothing
    Set objWordApp = Nothing
End Sub

关键修改说明 #

• 插入位置定位：用objWordDoc.Content.End替代原代码的objWordDoc.Range，确保每次表格都插入到文档末尾，不会覆盖之前的内容
• 冗余代码移除：删除了原代码中未使用的rng变量及Union操作，简化逻辑
• 间距优化：在每个表格插入后，在文档末尾添加空段落，保证表格之间有清晰的间隔

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