Copy only 10 row from Visible Rows

BillLambeer

Board Regular
Joined
Jan 14, 2003
Messages
51
I have a sheet which I Autofilter with a macro. However I only want to copy the first 10 rows that the Autofilter returns.
For example, I ask the Autofilter to return the Top 10 values. If all the values are the same it will return all the rows. I want to be able to copy only the first 10 of those rows.
Basically, I want to be able to copy a specific number of visible rows. Should I do this with a loop or is there a way to tell the Autofilter to return the top 10 values up to a maximum of 10 rows?
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

maytas

New Member
Joined
Sep 5, 2006
Messages
18
Hi,

Code:
Sub Filter_Field_Copy()
    Dim Filter_Field As Range, Top_10 As Range
    If ActiveSheet.FilterMode Then
        Set Filter_Field = ActiveSheet.AutoFilter.Range
        Set Top_10 = Range(Filter_Field.SpecialCells(xlCellTypeVisible).Areas(2), Filter_Field.SpecialCells(xlCellTypeVisible).Areas(11)) ''without header
        Worksheets(2).Cells.Clear
        Top_10.Copy Worksheets(2).Range("A1")
    ActiveSheet.ShowAllData
    Else: MsgBox "In this worksheet there is not filtered field.", vbCritical, "Attention."
    End If
    Set Filter_Field = Nothing
    Set Top_10 = Nothing
End Sub
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Hi,

maytas, I cannot make your code work
to my sense it's not bugfree: why would the visible range have at least 11 areas ? and why do you think would those areas have only 1 row ?
perhaps I'm missing something ?

couldn't find code without loop
Code:
Option Explicit

Sub Filter_Field_Copy()
'Erik Van Geit
'060915
'copy first visible rows (determine headerrow & number of rows to get)

    Dim TopRange As Range
    Dim i As Integer
    Dim LR As Long      'Last Row
    Dim c As Range
    
'**** EDIT these lines ****
    Const HR = 1        'Header Row
    Const NR = 10       'Number of Rows to copy
'**** END EDIT ****

    If ActiveSheet.FilterMode Then
        
        Set c = Cells(HR, 1)
        
        For i = 1 To NR
        Set c = Range(c(2), Cells(Rows.Count, c.Column)).SpecialCells(xlCellTypeVisible)(1)
        Next i
        LR = c.Row
        
        Set TopRange = Intersect(ActiveSheet.UsedRange, Rows(HR + 1 & ":" & LR))
        TopRange.Copy Worksheets(2).Range("A1")

    ActiveSheet.ShowAllData
    Else: MsgBox "In this worksheet there is no autofilter active.", vbCritical, "Attention."
    End If

    Set TopRange = Nothing

End Sub
kind regards,
Erik
 

maytas

New Member
Joined
Sep 5, 2006
Messages
18
Hi,
Sory for my bad english.
Erik, I again trying my code, it is working.
 

Boller

Banned
Joined
Apr 11, 2006
Messages
2,328

ADVERTISEMENT

Another way :-

Code:
Sub Macro1()
Dim rng As Range, rng2 As Range, dest As Range
With Sheets("Sheet1")
    Set rng = .Range(.[A1], .[A65536].End(xlUp))
End With
rng.AutoFilter Field:=1, Criteria1:="10", Operator:=xlTop10Items
Set rng2 = rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
Set dest = Sheets("Sheet2").[A65536].End(xlUp)(2)
rng2.Copy dest
Range(dest(11), dest(11).End(xlDown)).EntireRow.Delete
rng.AutoFilter
End Sub

(You stated that you only want to copy/paste the first 10 visible rows of the filtered data - note that this will not necessarily result in the top 10 items being pasted.
If you are able to sort your data then you don't need to use AutoFilter.
Could sort desecnding and copy/paste the first 10 rows.)
 

BillLambeer

Board Regular
Joined
Jan 14, 2003
Messages
51
Erik,
Works great. Thanks. I didn't really think of the sort because I like the simplicity of Autofilter. Seems like it would work though.
 

Boller

Banned
Joined
Apr 11, 2006
Messages
2,328

ADVERTISEMENT

I didn't really think of the sort because I like the simplicity of Autofilter.

As mentioned in my previous post, if you need the real top 10 items and not just the first 10 rows of the filtered items, you would need to sort the data before filtering.
In which case you don't need to filter - only need to sort.
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Hi,
Sory for my bad english.
Erik, I again trying my code, it is working.
Hi,

try with little data

header
AAA
... 20 rows
AAA
BBB
... 20 rows
AAA
AAA
BBB
CCC
CCC
filter for AAA
does it work ?

for me it bugs on line
Code:
        Set Top_10 = Range(Filter_Field.SpecialCells(xlCellTypeVisible).Areas(2), Filter_Field.SpecialCells(xlCellTypeVisible).Areas(11)) ''without header
reasons explained in previous post

kind regards,
Erik
 

maytas

New Member
Joined
Sep 5, 2006
Messages
18
Hi.
Erik,you are true.
In your example data i give error.
When filtered data is in contiguous cells, then it is not working correctly.
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
when filtered data is in contiguous cells, then it is not working correctly
that's because there will not be 11 areas when the data are contiguous

kind regards,
Erik
 

Forum statistics

Threads
1,136,349
Messages
5,675,244
Members
419,557
Latest member
razlevav

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top