VBA代码报错Runtime Error '5941'与Error 91，求解决表格行查找复制问题

Runtime Error '5941'（请求的集合成员不存在） #

• 当当前文档的表格总数不足9个时，代码尝试访问ActiveDocument.Tables(8)或ActiveDocument.Tables(9)，这两个索引对应的表格不存在，触发该错误。
• 代码未提前校验文档表格数量，直接硬索引访问第8、9个表格，存在越界风险。

Object variable not set (Error 91) #

• 代码中ChangeFileOpenDirectory "C:".Activate是无效语法：ChangeFileOpenDirectory仅用于设置默认打开目录，不返回可调用.Activate的对象，导致对象未引用错误。
• 未创建或指定目标新文档，代码尝试通过Selection粘贴，但Selection的上下文未指向新文档，本质是缺少对目标文档的对象引用。

Dim z As Long
Dim v As Long
Dim sourceTable As Table
Dim newDoc As Document

' 创建新文档并赋值给对象变量
Set newDoc = Documents.Add

' 提前校验当前文档表格数量，避免越界
If ActiveDocument.Tables.Count < 9 Then
    MsgBox "当前文档表格数量不足9个，无法执行操作。", vbExclamation
    Exit Sub
End If

' 遍历第8、9个表格
For z = 8 To 9
    Set sourceTable = ActiveDocument.Tables(z)
    ' 遍历当前表格的每一行
    For v = 1 To sourceTable.Rows.Count
        ' 直接使用行的Range对象查找，避免依赖Selection
        With sourceTable.Rows(v).Range.Find
            .Text = "apples"
            .Execute
            ' 找到目标内容时复制粘贴到新文档
            If .Found Then
                sourceTable.Rows(v).Copy
                ' 在新文档末尾插入换行（可选，避免表格粘连）
                newDoc.Content.InsertAfter vbCr
                newDoc.Content.PasteAndFormat wdFormatOriginalFormatting
            End If
        End With
    Next v
Next z

' 可选：保存新文档（替换为你的目标路径）
' newDoc.SaveAs2 "C:\你的保存路径\结果文档.docx"

关键优化点 #

1. 添加表格数量校验：提前判断当前文档是否有足够的表格，避免越界错误。
2. 使用对象引用替代Selection：直接操作表格、行的Range对象，避免Selection上下文混乱的问题，代码更稳定高效。
3. 明确新文档对象：创建新文档并赋值给newDoc变量，确保粘贴操作的目标明确。
4. 移除无效语法：删除错误的ChangeFileOpenDirectory调用，如需设置保存目录可在SaveAs2时指定。

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