Excel筛选无结果时取消筛选及结果复制的VBA实现求助

问题根源分析 #

• 你之前的If语句直接走Else分支，大概率是判断筛选结果的逻辑出错——比如直接统计可见行数时把第7行的表头也算进去了，导致误判为无结果。
• 另外要注意：表头在第7行，必须从这一行开始设置筛选区域，不能包含上方的空白或无关行。

可直接运行的VBA代码 #

Sub FilterAndCopy()
    Dim wsSource As Worksheet
    Dim wsNew As Worksheet
    Dim lastRow As Long
    Dim filterRange As Range
    Dim visibleRows As Range
    
    ' 替换成你的源工作表名称
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    
    ' 先取消已有筛选，避免干扰新筛选
    If wsSource.AutoFilterMode Then wsSource.AutoFilterMode = False
    
    ' 找到D列最后一行数据的行号
    lastRow = wsSource.Cells(wsSource.Rows.Count, "D").End(xlUp).Row
    
    ' 定义筛选区域：从第7行表头到数据最后一行的所有列
    Set filterRange = wsSource.Range("A7:" & wsSource.Cells(lastRow, wsSource.Columns.Count).Address)
    
    ' 设置D列的筛选条件，替换成你需要的条件（比如"已完成"、">50"）
    filterRange.AutoFilter Field:=4, Criteria1:="你的筛选条件"
    
    ' 捕获无筛选结果时的错误
    On Error Resume Next
    ' 获取筛选后的可见行，用Offset(1,0)跳过第7行的表头
    Set visibleRows = filterRange.Offset(1, 0).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not visibleRows Is Nothing Then
        ' 新建工作表
        Set wsNew = ThisWorkbook.Worksheets.Add
        ' 把筛选结果复制到新表的A1位置
        visibleRows.Copy wsNew.Range("A1")
        ' 取消源表的筛选状态
        wsSource.AutoFilterMode = False
    Else
        ' 没有筛选结果，直接取消筛选
        wsSource.AutoFilterMode = False
    End If
End Sub

关键注意事项 #

• 筛选区域要准确：必须从第7行表头开始覆盖所有数据列，不然筛选只会作用于部分区域。
• 跳过表头判断结果：用Offset(1,0)排除第7行的表头，这样判断的是真正的筛选数据行是否存在。
• 错误处理不能少：无筛选结果时SpecialCells会报错，用On Error Resume Next捕获后，visibleRows会变成Nothing，这时就会走Else分支取消筛选。

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