Select first 5 visible rows

[Paul Brown]

I have a filtered spreadsheet and am trying to select the first 5 visible
rows to copy onto a separate sheet.

I can use ActiveCell.Offset(1,0).Select to get the next row down but how can
I move on until the next row is visible (looping?) and how can I then
continue to move down and in addition to the first selected visible row
select the next 4 visible rows? I can then paste all 5 elsewhere.
Alternatively, do I have to select each visible row individually and paste
elsewhere within the loop? If so, how do I stop the loop running after the
fifth time?

A little knowledge is a dangerous thing!

Really grateful for any assistance with this.

Paul.

 

[Dave Peterson]

Dim HowManyVisRows as long
dim VisRng as range
dim myCell as range
dim iCtr as long

'apply the filter someway

With worksheets("somesheetname").autofilter.range
'subtract one for the header.
howmanyvisrows _
= .columns(1).cells.specialcells(xlcelltypevisible).cells.count - 1

if howmanyvisrows >= 5 then
'avoid the header and come down one row
'and only look at one the first column
set visrng = .resize(.rows.count-1, 1).offset(1,0) _
.cells.specialcells(xlcelltypevisible)
else
set visrng = nothing
end if
end with

if visrng is nothing then
'warning message???
msgbox "not enough visible rows!
else
ictr = 0
for each mycell in visrng.cells
ictr = ictr + 1
if ictr > 5 then
exit for
end if
mycell.entirerow.copy _
destination:=somewhereelse
next mycell
end if

Untested, uncompiled--watch for typos.

 

[Paul Brown]

Many thanks Dave,

I will give it a go.

Dim HowManyVisRows as long
dim VisRng as range
dim myCell as range
dim iCtr as long

'apply the filter someway

With worksheets("somesheetname").autofilter.range
'subtract one for the header.
howmanyvisrows _
= .columns(1).cells.specialcells(xlcelltypevisible).cells.count - 1

if howmanyvisrows >= 5 then
'avoid the header and come down one row
'and only look at one the first column
set visrng = .resize(.rows.count-1, 1).offset(1,0) _
.cells.specialcells(xlcelltypevisible)
else
set visrng = nothing
end if
end with

if visrng is nothing then
'warning message???
msgbox "not enough visible rows!
else
ictr = 0
for each mycell in visrng.cells
ictr = ictr + 1
if ictr > 5 then
exit for
end if
mycell.entirerow.copy _
destination:=somewhereelse
next mycell
end if

Untested, uncompiled--watch for typos.