Excel VBA问题：筛选后复制表格前5行至M7的宏频繁报错

原宏执行时频繁报错，核心问题如下：

• 当筛选后可见数据行不足2行时，r(2)会触发下标越界错误
• 对不连续的可见区域直接使用Range(r(2), rWC)会导致引用逻辑错误
• 未处理无可见数据行的场景，引发SpecialCells相关异常

以下是修正后的宏代码，针对上述问题逐一解决：

Sub TopNRows()
    Dim ws As Worksheet
    Dim dataRange As Range
    Dim visibleRows As Range
    Dim cell As Range
    Dim copyRange As Range
    Dim rowCount As Long
    Dim maxRows As Long
    
    ' 指定源工作表（按需替换为实际表名，比如ThisWorkbook.Sheets("数据Sheet")）
    Set ws = ActiveSheet
    maxRows = 5 ' 要复制的最大行数
    
    ' 定义完整数据区域：从B16到B列最后一行，覆盖B-H共7列
    On Error Resume Next
    Set dataRange = ws.Range("B16:H" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)
    On Error GoTo 0
    
    ' 无数据行直接退出
    If dataRange Is Nothing Then Exit Sub
    
    ' 获取筛选后的可见数据区域
    On Error Resume Next
    Set visibleRows = dataRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' 无可见数据直接退出
    If visibleRows Is Nothing Then Exit Sub
    
    ' 遍历可见行，收集前maxRows行数据
    rowCount = 0
    For Each cell In visibleRows.Columns(1).Cells
        rowCount = rowCount + 1
        ' 合并要复制的7列区域
        If copyRange Is Nothing Then
            Set copyRange = ws.Range(cell, cell.Offset(0, 6))
        Else
            Set copyRange = Union(copyRange, ws.Range(cell, cell.Offset(0, 6)))
        End If
        ' 达到指定行数后停止遍历
        If rowCount >= maxRows Then Exit For
    Next cell
    
    ' 复制到目标位置Sheet7!M7
    If Not copyRange Is Nothing Then
        copyRange.Copy Destination:=Sheet7.Range("M7")
    End If
End Sub

修正说明 #

1. 异常场景处理：增加了对无数据行、无可见数据的判断，避免空对象引发的运行时错误
2. 不连续区域处理：通过Union方法逐行合并可见区域，解决筛选后数据分散的问题
3. 明确区域范围：直接定义B-H列的完整数据区域，替代原代码中Resize(,7)的模糊引用
4. 清晰的目标定位：使用Destination参数指定复制目标，逻辑更直观

注意事项 #

• 如果源工作表不是当前活动表，修改Set ws = ActiveSheet为具体工作表名称，例如Set ws = ThisWorkbook.Sheets("你的数据工作表")
• 确保表头B15:H15已开启自动筛选，若未开启可在宏开头添加ws.Range("B15:H15").AutoFilter

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