VBA执行筛选复制操作时报Object invoked has disconnected错误如何解决

报错原因 #

• 代码中Range("PCTable[xxx]")的结构化表引用没有显式指定所属工作表，默认指向代码运行时的活动工作表，当活动工作表不是「Paycode Checks」时，对象引用就会失效，触发断开错误。
• 多次调用剪贴板执行复制粘贴操作，COM对象调用过程中容易出现上下文丢失，尤其是工作簿存在动态计算规则、外部数据连接时更易触发该错误。
• 原有写法会把筛选后的隐藏行也一起复制，不符合仅复制筛选结果的需求。

修复方案 #

显式绑定表对象，优化复制逻辑规避COM对象调用错误，优化后代码如下：

Sub fHrsErrors()
    Application.ScreenUpdating = False
    ' 显式声明所有对象
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim tbl As ListObject
    Dim HrsFilter As Range
    Dim arrCol, i As Long
    
    ' 绑定工作表和表对象
    Set wsSource = ThisWorkbook.Sheets("Paycode Checks")
    Set wsTarget = ThisWorkbook.Sheets("Hours Errors")
    Set tbl = wsSource.ListObjects("PCTable")
    
    ' 清空目标表旧数据
    wsTarget.Range("A2:F" & wsTarget.Rows.Count).ClearContents
    
    ' 执行筛选
    With tbl.AutoFilter.Range
        .AutoFilter Field:=10, Criteria1:="<>0"
        On Error Resume Next ' 处理无可见行的情况
        Set HrsFilter = .Columns(1).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
    End With
    
    If HrsFilter Is Nothing Or HrsFilter.Cells.Count = 1 Then
        wsTarget.Range("A2").Value = "No Results Found"
    Else
        ' 按顺序指定要复制的列名
        arrCol = Array("Employee", "PayCode", "Sum of Wrkd_Hours", "FF Hrs", "CGC Hrs", "Hrs Diff")
        ' 逐列赋值，仅复制可见行
        For i = LBound(arrCol) To UBound(arrCol)
            tbl.ListColumns(arrCol(i)).DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
            wsTarget.Cells(2, i + 1).PasteSpecial Paste:=xlPasteValues
        Next i
        ' 清空剪贴板
        Application.CutCopyMode = False
    End If
    
    ' 取消筛选恢复原表状态
    tbl.AutoFilter.ShowAllData
    
    Application.ScreenUpdating = True
End Sub

额外优化点 #

• 提前清空目标表历史数据，避免旧数据残留
• 增加错误处理规避无可见行时SpecialCells抛出的错误
• 执行完成后恢复原表的筛选状态，不影响原始数据展示
• 所有对象都显式绑定所属工作簿和工作表，完全避免引用失效问题

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