VBA使用AutoFilter后如何复制指定过滤单元格区域（不含表头）

问题根源分析 #

1. 未指定工作表的LR计算错误：你用Cells(Rows.Count, 1).End(xlUp).Row计算最后一行时，Cells默认指向当前激活的工作表。如果第一次运行时激活的是新建的空工作表，lastRow会被计算为1，此时Range("A2:A1")是无效范围，Excel会自动修正为Range("A1:A1")，导致复制了表头。
2. 未针对筛选可见区域复制：直接复制A2:A&LR会包含隐藏行，且当LR计算错误时会触发Excel的范围修正逻辑。

解决思路与代码示例 #

1. 明确指定工作表计算最后一行

永远不要依赖默认激活的工作表，直接指定源工作表对象计算行号：

' 正确计算源表第一列最后一行
Dim lastRow As Long
lastRow = Worksheets("my sheet").Cells(Worksheets("my sheet").Rows.Count, 1).End(xlUp).Row

更简洁的写法是先赋值工作表变量：

Dim sourceWs As Worksheet
Set sourceWs = ThisWorkbook.Worksheets("my sheet")
lastRow = sourceWs.Cells(sourceWs.Rows.Count, 1).End(xlUp).Row

2. 仅复制筛选后的可见区域

使用SpecialCells(xlCellTypeVisible)获取筛选后显示的行，跳过表头：

' 复制源表A2到最后一行的可见区域
sourceWs.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible).Copy

3. 控制粘贴位置避免覆盖目标表头

粘贴时指定目标表的起始位置（比如A2），不要直接粘贴到A1：

Dim targetWs As Worksheet
Set targetWs = ThisWorkbook.Worksheets("你的目标工作表名称")
targetWs.Range("A2").PasteSpecial Paste:=xlPasteValues ' 按需选择粘贴类型（值/格式等）
Application.CutCopyMode = False ' 清除剪贴板状态

完整可运行代码 #

Sub CopyFilteredDataWithoutHeader()
    Dim sourceWs As Worksheet
    Dim targetWs As Worksheet
    Dim lastRow As Long
    
    ' 初始化工作表对象
    Set sourceWs = ThisWorkbook.Worksheets("my sheet")
    Set targetWs = ThisWorkbook.Worksheets("新建工作表") ' 替换为你的目标表名
    
    ' 应用筛选条件
    sourceWs.Range("A1").AutoFilter Field:=14, Criteria1:="my criteria"
    
    ' 计算源表第一列最后一行
    lastRow = sourceWs.Cells(sourceWs.Rows.Count, 1).End(xlUp).Row
    
    ' 复制筛选后可见的非表头区域
    sourceWs.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible).Copy
    
    ' 粘贴到目标表的A2位置
    targetWs.Range("A2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
End Sub

为什么格式化后运行正常？ #

当你手动格式化目标表的A1、B1后，大概率激活了源工作表my sheet，此时Cells(Rows.Count,1)指向源表的单元格，lastRow计算正确，复制范围A2:A&LR有效，所以不会触发Excel的范围修正，也就不会复制表头。

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