VBA复制筛选后前20行至新工作表报错，求解决方法

错误原因 #

你遇到的报错核心问题有两个：

• 所有Range调用未指定具体工作表，VBA默认使用当前活动工作表，如果代码运行时活动表不是数据所在表，会直接导致引用混乱，触发Method 'Range' of object '_Global' failed错误。
• 逐个单元格用Union构建范围的方式效率低，且当可见单元格不足140个时，rng20会保持Nothing状态，执行Debug.Print或复制操作时直接报错。另外你用rng20.Cells.Count = 140判断停止循环的逻辑有漏洞：筛选后的可见单元格是分散的，可能提前凑够单元格数但没取到完整20行。

优化后的代码 #

方法1：直接提取前20个可见行（推荐） #

跳过逐个单元格遍历，直接针对可见行操作，高效又准确：

Sub TwentyRows()
    Dim sourceWs As Worksheet
    Dim targetWs As Worksheet
    Dim visibleRows As Range
    Dim rowCounter As Integer
    Dim currentRow As Range
    
    ' 指定数据源和目标工作表，避免依赖活动表
    Set sourceWs = ThisWorkbook.Worksheets("你的数据工作表名") ' 替换成实际表名
    Set targetWs = ThisWorkbook.Worksheets("Sheet2")
    
    ' 清空目标表原有数据
    targetWs.Cells.Clear
    
    ' 获取筛选后的可见行（从第16行开始）
    On Error Resume Next
    Set visibleRows = sourceWs.Range("A16:H520").SpecialCells(xlCellTypeVisible).EntireRow
    On Error GoTo 0
    
    If visibleRows Is Nothing Then
        MsgBox "没有符合条件的可见行！"
        Exit Sub
    End If
    
    rowCounter = 0
    ' 遍历可见行，复制前20行的A-H列到目标表
    For Each currentRow In visibleRows
        If rowCounter >= 20 Then Exit For
        sourceWs.Range("A" & currentRow.Row & ":H" & currentRow.Row).Copy _
            targetWs.Range("A" & rowCounter + 1)
        rowCounter = rowCounter + 1
    Next currentRow
End Sub

方法2：修正你的原代码逻辑 #

如果想保留核心思路，补上工作表指定和空值判断：

Sub TwentyRows_Fixed()
    Dim rng As Range
    Dim rngF As Range
    Dim rng20 As Range
    Dim sourceWs As Worksheet
    
    ' 指定数据源工作表
    Set sourceWs = ThisWorkbook.Worksheets("你的数据工作表名") ' 替换成实际表名
    
    On Error Resume Next
    Set rngF = sourceWs.Range("A16:H520").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If rngF Is Nothing Then
        MsgBox "没有符合条件的可见单元格！"
        Exit Sub
    End If
    
    For Each rng In sourceWs.Range("A16:H520")
        If Not Intersect(rng, rngF) Is Nothing Then
            If rng20 Is Nothing Then
                Set rng20 = rng
            Else
                Set rng20 = Union(rng20, rng)
            End If
            ' 按7列一组判断，确保取满20行
            If rng20.Cells.Count >= 140 Then
                Set rng20 = rng20.Resize(140)
                Exit For
            End If
        End If
    Next rng
    
    If Not rng20 Is Nothing Then
        Debug.Print rng20.Address
        rng20.Copy targetWs.Range("A1")
    End If
End Sub

批量筛选代码的小优化 #

你原批量筛选代码里的On Error Resume Next会掩盖错误（比如某表无E15单元格时默默跳过），建议改成：

Sub BatchFilter()
    Dim xWs As Worksheet
    For Each xWs In ThisWorkbook.Worksheets
        ' 先判断表头是否存在，避免无数据时报错
        If xWs.Range("E15").Value <> "" Then
            xWs.Range("E15").AutoFilter Field:=5, Criteria1:">0.002"
        End If
    Next xWs
End Sub

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