为跨工作簿复制数据的VBA代码添加源文件筛选器清除规则

要解决源工作簿带筛选器时复制数据异常的问题，只需在复制数据前强制清除源工作表的所有筛选状态，确保所有数据都能被选中复制。以下是修改后的完整代码：

Sub Update()
    Dim sourceWorkbook As Workbook
    Dim destinationWorkbook As Workbook
    Dim sourceSheet As Worksheet
    Dim destSheet As Worksheet
    Dim tbl As ListObject
    
    ' 打开源工作簿
    Set sourceWorkbook = Workbooks.Open(Filename:="D:\Desktop\Stop Work.xlsm")
    Set sourceSheet = sourceWorkbook.Worksheets("Sheet1")
    
    ' 清除源工作表的所有筛选（覆盖普通自动筛选和表格筛选两种情况）
    With sourceSheet
        ' 关闭普通区域的自动筛选
        If .AutoFilterMode Then .AutoFilterMode = False
        ' 遍历所有表格，清除表格的筛选状态
        For Each tbl In .ListObjects
            If tbl.AutoFilter.FilterMode Then tbl.AutoFilter.ShowAllData
        Next tbl
    End With
    
    ' 复制源工作表数据
    sourceSheet.Cells.Copy
    
    ' 打开目标工作簿并粘贴数据
    Set destinationWorkbook = Workbooks.Open(Filename:="D:\Desktop\AUTHs.xlsm")
    Set destSheet = destinationWorkbook.Worksheets("Stop Work")
    destSheet.Cells.PasteSpecial xlPasteAll
    
    ' 保存目标工作簿并关闭源工作簿
    destinationWorkbook.Save
    sourceWorkbook.Close SaveChanges:=False
    
    ' 原代码中的Select操作无实际意义，建议移除（依赖活动工作表易出错）
    ' ActiveSheet.ListObjects(1).ListColumns(1).Range.End(xlDown).Select
End Sub

关键修改说明： #

• 新增筛选清除逻辑：同时处理普通单元格区域的自动筛选和表格（ListObject）的筛选，确保所有隐藏行都被显示出来。
• 新增对象变量（sourceSheet、destSheet等），避免直接引用工作簿和工作表，提升代码稳定性。
• 注释掉原代码中无实际作用的Select操作，依赖ActiveSheet的代码容易因操作环境变化而出错。

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