VBA筛选后仅识别首行数据：如何复制全部符合条件的筛选行？

一、VBA仅显示首行的原因 #

你通过SpecialCells(xlCellTypeVisible)获取的可见区域是由多个不连续区块（Area）组成的Range集合，调试窗口默认只会展示第一个Area（也就是表头所在的第一行），但实际上rng变量已经包含了所有筛选后的可见行，这只是调试显示的视觉误区，并非真的只识别了首行。

二、排除表头并复制所有筛选行的修正代码 #

要复制排除表头的所有筛选结果，需要从数据区域的第二行开始获取可见行，以下是修正后的完整代码：

Sub TestFiltering()
    Dim wsSource As Worksheet
    Dim lastRow As Long
    Dim fullRange As Range
    Dim dataRange As Range ' 仅存放排除表头的数据区域
    Dim rngVisible As Range

    Set wsSource = ThisWorkbook.Sheets("SheetName")

    ' 用C列判断最后一行更准确（因为筛选的是C列数据）
    lastRow = wsSource.Cells(Rows.Count, "C").End(xlUp).Row
    Set fullRange = wsSource.Range("A1:G" & lastRow)
    ' 定义从第二行开始的数据区域，直接排除表头
    Set dataRange = wsSource.Range("A2:G" & lastRow)

    ' 清除原有筛选状态
    If wsSource.AutoFilterMode Then
        wsSource.AutoFilterMode = False
    End If

    ' 执行筛选逻辑
    fullRange.AutoFilter Field:=3, Criteria1:="<=-0.5", Operator:=xlOr, Criteria2:=">=0.5"

    ' 获取数据区域的可见行（自动排除表头）
    On Error Resume Next
    Set rngVisible = dataRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    ' 复制筛选结果到目标位置（示例：复制到Sheet2的A1单元格开始）
    If Not rngVisible Is Nothing Then
        rngVisible.Copy Destination:=ThisWorkbook.Sheets("Sheet2").Range("A1")
    Else
        MsgBox "没有符合条件的行"
    End If

    ' 可选：清除筛选，恢复表格显示
    wsSource.AutoFilterMode = False
End Sub

关键修改说明 #

• 新增dataRange变量，专门指向排除表头的数据区域，确保获取可见行时不会包含表头。
• 改用C列判断最后一行，避免因A列存在空行导致的范围计算错误。
• 增加了rngVisible的非空判断，防止无符合条件行时触发报错。

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