一种方法是使用SpecialCells(xlCellTypeVisible)获取所有可见单元格，然后使用Application.Union逐个循环并收集它们，以将它们限制到所需的数量。

Option Explicit

Public Sub Example()
    Dim Top800Cells As Range
    Set Top800Cells = GetTopVisibleRows(OfRange:=Range("A:A"), TopAmount:=800)
    
    Top800Cells.Select
End Sub

Public Function GetTopVisibleRows(ByVal OfRange As Range, ByVal TopAmount As Long) As Range
    Dim VisibleCells As Range
    Set VisibleCells = OfRange.SpecialCells(xlCellTypeVisible)
    
    If VisibleCells Is Nothing Then
        Exit Function
    End If
    
    Dim TopCells As Range
    Dim Count As Long
    Dim Row As Range
    
    For Each Row In VisibleCells.Rows
        If TopCells Is Nothing Then
            Set TopCells = Row
        Else
            Set TopCells = Application.Union(TopCells, Row)
        End If
        Count = Count + 1
        If Count = TopAmount Then Exit For
    Next Row
    
    Set GetTopVisibleRows = TopCells
End Function

如果你想在公式中使用它作为UDF（用户定义函数），SpecialCells(xlCellTypeVisible)会失败（参见SpecialCells(xlCellTypeVisible) not working in UDF），你需要自己检查可见性：

Public Function GetTopVisibleRows(ByVal OfRange As Range, ByVal TopAmount As Long) As Range
    Dim TopCells As Range
    Dim Count As Long
    Dim Row As Range
       
    For Each Row In OfRange.Rows
        If Not Row.EntireRow.Hidden Then
            If TopCells Is Nothing Then
                Set TopCells = Row
            Else
                Set TopCells = Application.Union(TopCells, Row)
            End If
            Count = Count + 1
            If Count = TopAmount Then Exit For
        End If
    Next Row
    
    Set GetTopVisibleRows = TopCells
End Function

复制SpecialCells(xlCellTypeVisible)的前 n 行

• 通常对更多列执行此操作，如代码中所示。
• 要仅将其应用于列A，请将Set rg = ws.Range("A1").CurrentRegion替换为

Set rg = ws.Range("A1").CurrentRegion.Columns(1)

假设标题在第一工作表行中。

• 简而言之，它在各行之间循环（rrg）的面积范围的（arg）（MultiRange，dvrg）每行计数（r）而当它击中“标记”时（DataRowsCount），则它使用此行（Set SetMultiRangeRow = rrg，lrrg）和第一行（frrg）作为range属性中的参数，以设置所需的范围，并重新应用相同类型的SpecialCells，以最终引用所需数量的行。

Sub ReferenceFirstMultiRangeRows()
    
    ' Define constants
    
    Const CriteriaColumn As Long = 1
    Const CriteriaString As String = "Yes"
    Const DataRowsCount As Long = 800
    
    ' Reference the worksheet ('ws').
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    If ws.AutoFilterMode Then ws.AutoFilterMode = False 
    
    ' Reference the ranges.
    
    Dim rg As Range ' the range (has headers)
    Set rg = ws.Range("A1").CurrentRegion ' you may need to use another way!
    
    Dim drg As Range ' the data range (no headers)
    Set drg = rg.Resize(rg.Rows.Count - 1).Offset(1)
    
    ' Apply the auto filter to the range.
    
    rg.AutoFilter CriteriaColumn, CriteriaString
    
    ' Attempt to reference the visible data range ('vdrg').
    
    Dim vdrg As Range
    
    On Error Resume Next
        Set vdrg = drg.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' Reference the required amount of visible rows ('vdrg').
    ' Reference the partial range ('vdrg') from the first row
    ' to the DataRowsCount-th row of the visible range
    ' and reapply special cells to this range.
    
    If Not vdrg Is Nothing Then ' filtered rows found
        Dim lrrg As Range: Set lrrg = SetMultiRangeRow(vdrg, DataRowsCount)
        If Not lrrg Is Nothing Then ' there are more rows than 'DataRowsCount'
            Dim frrg As Range: Set frrg = vdrg.Rows(1)
            Set vdrg = ws.Range(frrg, lrrg).SpecialCells(xlCellTypeVisible)
        'Else ' the visible data range is already set; do nothing
        End If
    'Else ' no filtered rows found; do nothing
    End If
    
    ws.AutoFilterMode = False ' remove the auto filter
    
    If vdrg Is Nothing Then
        MsgBox "No filtered rows.", vbExclamation
        Exit Sub
    End If
    
    ' Continue using vdrg e.g.:
    
    Debug.Print vdrg.Address ' only the first <=257 characters of the address
    
    'vdrg.Select
    'vdrg.Copy Sheet2.Range("A2")

End Sub

Function SetMultiRangeRow( _
    ByVal MultiRange As Range, _
    ByVal MaxRowNumber As Long) _
As Range
    
    Dim rCount As Long
    rCount = MultiRange.Cells.CountLarge / MultiRange.Columns.Count
    If rCount < MaxRowNumber Then Exit Function
    
    Dim arg As Range
    Dim rrg As Range
    Dim r As Long
    Dim lrrg As Range
    
    For Each arg In MultiRange.Areas
        For Each rrg In arg.Rows
            r = r + 1
            If r = MaxRowNumber Then
                Set SetMultiRangeRow = rrg
                Exit For
            End If
        Next rrg
    Next arg

End Function