Top 25 in a filtered list

[John Wilson]

I'm sure this has been answered before but I can't seem to
find it in the archives.

I'm looking to copy the top 25 visible rows on a filtered list.

Actually, to be specific......
Header row is 5
With the list filtered, I'm looking to copy only the first 25 visible
rows from Columns "C" through "H"

Thanks,
John

 

[John Wilson]

Found it.

Thanks Bernie

 

[Tom Ogilvy]

Assuming that you are not showing the top 25 - there are probably more than
25 rows visible then:

dim rng as Range, cell as Range
Dim rng1 as Range, rng2 as Range
set rng = ActiveSheet.AutoFilter.Range
set rng = rng.offset(1,0).Resize(rng.rows.count-1).Columns(1)
for each cell in rng
if cell.entirerow.Hidden = False then
if rng1 is nothing then
set rng1 = cell
else
set rng1 = union(rng,cell)
end if
end if
if rng1.count = 25 then exit for
Next
if not rng1 is nothing then
set rng2 = Intersect(rng1.EntireRow,Columns("C:H")
rng2.copy Destination:=Worksheets("Data1").Range("A2")
End if

 

[John Wilson]

Tom,

That worked too.

Thank you

What I found earlier from Bernie Deitrick was the following:

Dim myR As Range
Dim iRow As Integer
iRow = 25
Set myR = Range(Cells(6, 1), Cells(Rows.Count, 1).End(xlUp))
MsgBox "Visible row " & iRow & " is actual row " & _
GetVisibleRow(myR, iRow) & "."
Range(Range("C6"), Range("H" & LastVR)).Copy
Worksheets("top25Query").Activate
Range("B31").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

Function GetVisibleRow(myRange As Range, i As Integer) As Variant
Dim j As Integer
Dim myCell As Range
Set myRange = myRange.Offset(1, 0).Resize(myRange.Rows.Count - 1, 1)
j = 0
For Each myCell In myRange.SpecialCells(xlCellTypeVisible)
j = j + 1
If j = i Then
GetVisibleRow = myCell.Row
LastVR = myCell.Row
Exit Function
End If
Next
GetVisibleRow = "Not enough visible rows to return row " & i & "."
End Function