Filtering Tricks‎ > ‎

Copy X Rows

SAMPLE FILE: CopyXRows.xls

 
PROBLEM:
"I have a filtered set of data, I only want to copy the first 10 rows of the remaining visible data to another sheet.  How can I do that?"

SPECIFICATIONS:
  1. An AutoFilter is active on the sheet already
  2. The number of rows is easily editable (colored in the code below to draw attention)

CODE

Option Explicit

Sub Copy10Rows()
'Author:    Jerry Beaucaire, ExcelForum.com
'Date:      10/22/2010
'Summary:   Only copies 10 visible rows to new sheet
Dim LR As Long
Dim Rw As Long
Dim RwTenth As Long

LR = Range("A" & Rows.Count).End(xlUp).Row
Rw = 2

    Do
        If Rows(Rw).Hidden = False Then RwTenth = RwTenth + 1
        If RwTenth = 10 Then Exit Do
        Rw = Rw + 1
    Loop

Range("A2:A" & Rw).EntireRow.Copy _
    Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)

End Sub



From the MrExcel.com website comes this alternate technique that does the same thing without "looping".

CODE

Sub Copy10RowsDomenic()
'Author:    Domenic, MrExcel.com
'Date:      10/22/2010
'Summary:   Only copies 10 visible rows to new sheet, no loop version
'http://www.xl-central.com/about.html
'http://www.mrexcel.com/forum/showthread.php?t=511606
Dim LR As Long
Dim Rw As Long

LR = Cells(Rows.Count, "A").End(xlUp).Row
   
Rw = Application.Evaluate("SMALL(IF(SUBTOTAL(3,OFFSET(A2:A" & LR & ",ROW(A2:A" & _
    LR & ")-ROW(A2),0,1)),ROW(A2:A" & LR & ")),MIN(SUBTOTAL(3,A2:A" & LR & "),10))")

Range("A2:A" & Rw).EntireRow.Copy _
    Sheets("Sheet2").Range("A" & Sheets("Sheet2").Rows.Count).End(xlUp).Offset(1)
   
End Sub




Nothing says "thanks" like a steak dinner!
PayPal - The safer, easier way to pay online!
Comments