Excel VBA如何仅复制筛选后可见数据到新工作簿

直接调用工作表对象的Copy方法整表复制时，会把工作表内所有数据（包括筛选状态下的隐藏行、原表的筛选配置规则）全量同步到新工作表，未筛选的行只是被隐藏，没有被剔除，只要在新表取消筛选就能看到这部分内容。
另外你原有代码存在两处会导致运行异常的笔误：

• 筛选条件参数名写错：正确参数为Criteria1（末尾是数字1），不是Criterial（末尾是字母l）
• 代码里的引号是中文全角格式，VBA无法识别，需要替换为英文半角双引号

' 执行筛选，已修正原代码的参数拼写、引号格式问题
Test_Ready.Range("$A$2:$Q$2").AutoFilter Field:=1, Criteria1:=Macro_Rules.Range("CurrentTeam").Value, Operator:=xlAnd

' 在目标新工作簿中创建空白工作表，用于存放筛选后的数据
Dim targetWS As Worksheet
Set targetWS = newWB.Worksheets.Add(Before:=newWB.Sheets(newWB.Worksheets.Count))
' 如需同步原工作表名称，可取消下一行注释
' targetWS.Name = Test_Ready.Name

' 容错处理：避免筛选后无匹配可见行时触发运行错误
On Error Resume Next
' 仅定位、复制筛选后处于显示状态的可见单元格，隐藏的未筛选数据不会被选中
Test_Ready.UsedRange.SpecialCells(xlCellTypeVisible).Copy
' 将复制的可见内容粘贴到新工作表A1起始位置
targetWS.Range("A1").PasteSpecial Paste:=xlPasteAll
On Error GoTo 0

' 清空系统剪贴板，释放内存
Application.CutCopyMode = False

• 复制过程只会选中筛选后可见的行/单元格，未通过筛选的隐藏行不会被复制到新工作表，从根源上避免隐藏数据被带入
• 新工作表是空白表新建后粘贴内容，不会携带原表的筛选配置，不存在通过调整筛选选项调出隐藏数据的可能
• 粘贴时保留原可见单元格的格式、公式、值，和手动选中可见单元格复制粘贴的效果完全一致

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