VBA过滤WB1数据并复制到新建WB2时出现1004错误求助

问题根源分析 #

你的代码出现报错主要有以下几个关键问题：

• 未限定工作表的Range引用：代码中Range("A" & Rows.Count)和Range("A1:CS" & LR)未指定所属工作表，新建并保存目标工作簿后，当前活动工作簿切换为新文件，此时Range会默认指向空的目标工作表，导致引用混乱。
• 未清除原有筛选状态：如果源工作表Sheet1之前已经处于筛选状态，再次调用AutoFilter会触发1004错误。
• 过早关闭剪贴板模式：Copy后立即设置Application.CutCopyMode = False会清空剪贴板，导致后续PasteSpecial操作失败。
• 保存时机不合理：提前保存目标工作簿会切换活动工作簿，增加引用错误的概率。

修正后的代码 #

Dim wbI As Workbook, wbO As Workbook
Dim wsI As Worksheet, wsO As Worksheet
Dim LR As Long

' 绑定源工作簿和工作表
Set wbI = ThisWorkbook
Set wsI = wbI.Sheets("Sheet1")

' 新建目标工作簿并绑定工作表
Set wbO = Workbooks.Add
Set wsO = wbO.Sheets("Sheet1")

' 清除源工作表的现有筛选（如果存在）
If wsI.AutoFilterMode Then wsI.AutoFilterMode = False

' 执行筛选操作
wsI.Range("A1").AutoFilter Field:=1, Criteria1:="APL 1"

' 计算源数据最后一行（必须指定源工作表）
LR = wsI.Range("A" & wsI.Rows.Count).End(xlUp).Row

' 复制筛选后的可见数据（指定源工作表）
wsI.Range("A1:CS" & LR).SpecialCells(xlCellTypeVisible).Copy

' 粘贴到目标工作表
wsO.Range("A1").PasteSpecial xlPasteValues

' 关闭剪贴板模式（粘贴完成后再执行）
Application.CutCopyMode = False

' 保存目标工作簿
wbO.SaveAs Filename:="C:\Users\X\Y\NewFile.xlsx"
wbO.Close SaveChanges:=False ' 已通过SaveAs保存，此处无需重复保存

' 可选：恢复源工作表的无筛选状态
wsI.AutoFilterMode = False

关键修改说明 #

1. 强制限定工作表归属：所有涉及源数据的Range操作都加上wsI.前缀，确保始终操作源工作簿的Sheet1，不受活动工作簿切换影响。
2. 预处理筛选状态：先检查并清除源工作表的现有筛选，避免重复筛选触发错误。
3. 调整剪贴板操作时机：在粘贴完成后再关闭剪贴板模式，保证粘贴数据有效。
4. 优化保存逻辑：完成数据粘贴后再保存目标工作簿，减少不必要的工作簿切换操作。

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