如何编写VBA宏将Word表格第5行起内容复制到另一文档表格指定单元格

该需求完全可实现，你现有代码存在几处需要调整的问题，修正后即可正常运行：

现有代码问题说明 #

• 固定取第5行到25行的范围，没有实现「取第5行开始所有后续行」的需求
• 遍历源文档所有表格的逻辑会导致剪贴板被反复覆盖，最终仅能复制最后一个表格的选中内容，若你仅需要提取源文档第一个表格的内容可直接删除循环逻辑
• 粘贴位置指向目标表格第5行第1列的单元格内部，会导致所有复制内容塞入同一单元格，不符合插入到第5行位置的需求

修正后代码 #

Sub ExtractTable()
    Dim objSourceDoc As Document
    Dim objTargetDoc As Document
    Dim objSourceTable As Table
    Dim objCopyRange As Range
    Dim lngSourceRows As Long
    
    ' 定义源文档（当前激活的文档）
    Set objSourceDoc = ActiveDocument
    ' 此处如果源文档只有一个需要提取的表格，直接取第一个表格，按需调整索引
    Set objSourceTable = objSourceDoc.Tables(1)
    ' 获取源表格总行数
    lngSourceRows = objSourceTable.Rows.Count
    
    ' 异常判断：源表格不足5行时直接退出
    If lngSourceRows < 5 Then
        MsgBox "源表格行数不足，无需提取"
        Exit Sub
    End If
    
    ' 选中源表格第5行到最后一行的范围
    Set objCopyRange = objSourceDoc.Range( _
        Start:=objSourceTable.Rows(5).Range.Start, _
        End:=objSourceTable.Rows(lngSourceRows).Range.End)
    objCopyRange.Copy
    
    ' 打开目标模板文档，注意如果是已经打开的文档可以用Documents("文件名")直接引用
    Set objTargetDoc = Documents.Add("C:\dcam\Setup Sheets\lineup-sheet-template.html")
    
    ' 定位到目标表格第5行的起始位置，粘贴复制的行
    With objTargetDoc.Tables(1)
        .Rows(5).Range.Select
        Selection.PasteAppendTable
    End With
    
    ' 清理对象
    Set objCopyRange = Nothing
    Set objSourceTable = Nothing
    Set objSourceDoc = Nothing
    Set objTargetDoc = Nothing
End Sub

代码说明 #

• 使用Rows.Count动态获取源表格总行数，不需要硬编码行号，适配不同长度的源表格
• 使用PasteAppendTable方法粘贴，会自动将复制的行合并到目标表格中，不会出现格式错乱
• 增加了源表格行数校验逻辑，避免下标越界报错
• 如果你需要处理源文档的所有表格，可以自行调整外层遍历逻辑，每次复制后追加到目标表格的对应位置即可

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