如何将转置后的Excel表格导出至Word？现有VBA代码异常求助

原代码的核心问题在于未实现转置表格的需求，且错误地将表头行单独生成了一个表格。具体问题点：

• 循环包含表头行，导致生成多余的表头表格
• 创建的表格结构是1行多列（横向），而非需求的多行2列（转置后表头为第一列，数据为第二列）
• 未将表头与对应数据行组合成同一表格

以下是修正后的代码，完全符合需求：

Sub mkDocWithBorders()
    Dim wb As Workbook, sht As Worksheet, rng As Range
    Dim lastRow As Long, lastCol As Long, dataRow As Long, col As Long
    Dim wApp As Object, wDoc As Object, wTbl As Object
   
    ' 绑定当前工作簿和工作表
    Set wb = ThisWorkbook
    Set sht = wb.Sheets(1)
   
    ' 获取有效行、列数（表头为第1行，数据从第2行开始）
    lastRow = sht.UsedRange.Rows.Count
    lastCol = sht.UsedRange.Columns.Count
    Set rng = sht.Range(sht.Cells(1, 1), sht.Cells(lastRow, lastCol))
   
    ' 启动Word并新建文档
    Set wApp = CreateObject("Word.Application")
    wApp.Visible = True
    Set wDoc = wApp.Documents.Add
   
    ' 遍历每一行数据（从第2行开始，跳过表头）
    For dataRow = 2 To lastRow
        ' 表格间添加空段分隔
        If dataRow > 2 Then
            wDoc.Paragraphs.Add
        End If
       
        ' 创建y行2列的表格（y为列数，每行对应一对表头+数据）
        Set wTbl = wDoc.Tables.Add(wDoc.Paragraphs.Last.Range, lastCol, 2)
       
        ' 填充表格内容并设置全边框
        With wTbl
            ' 启用全边框
            .Borders.Enable = True
            ' 遍历每一列，将表头放入第1列，对应数据放入第2列
            For col = 1 To lastCol
                .Cell(col, 1).Range.Text = rng.Cells(1, col).Value
                .Cell(col, 2).Range.Text = rng.Cells(dataRow, col).Value
            Next col
        End With
    Next dataRow
   
    ' 释放对象
    Set wTbl = Nothing
    Set wDoc = Nothing
    Set wApp = Nothing
End Sub

代码说明 #

• 表格结构调整：每个数据行对应一个lastCol行×2列的表格，满足表头转首列的需求
• 循环范围修正：从第2行开始遍历数据行，避免生成单独的表头表格
• 内容填充逻辑：将每行数据与表头逐列配对，放入表格的对应行中
• 格式保留：保留全边框设置，同时表格间添加空段实现上下排列的间隔

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