Select and copy a specific number of filtered rows using VBA in excel

Question

I'm using AutoFilter on a huge list and want to copy the first visible 200 rows. My code is static since it only select down to row 201. I want to have a dynamic code where I select the first visible 200 rows when filter is used (excluding header). This is how my code looks today:

Sheets("Sheet1").Select
Range("A2:A201").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Please check this link http://www.thesmallman.com/blog/2016/11/27/copypaste-top-n-visible-rows it has your answer. — Maddy, Apr 09 '18 at 14:04
Thanks for the link! This helped me to get the solution. I posted my final VBA-code below. — Oskar Kuusela, Apr 16 '18 at 07:48
np. you should avoid using `.Select` in your code. https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba — Maddy, Apr 16 '18 at 08:11

score 2 · Answer 1 · answered Apr 09 '18 at 14:13

2

This will copy only the first visible 200 items in column A, excluding the header:

Sub AutoFilterCopyVisible()
    Dim r1 As Range, r2 As Range

    Set r1 = Sheets("Sheet1").AutoFilter.Range.Offset(1, 0).Resize(200, 1)
    Set r2 = Sheets("Sheet2").Range("A1")

    r1.Copy r2
End Sub

answered Apr 09 '18 at 14:13

Gary's Student

95,722
10
59
99

This does still only copy the first 200 rows, not the first visible 200 rows. I only get 134 rows copied to Sheet2. – Oskar Kuusela Apr 10 '18 at 06:51

score 1 · Accepted Answer · answered Apr 16 '18 at 07:42

Here's how I solved it!

The first 200 visible rows are copied from Sheet1 A11 (2 columns) to Sheet2 A2. And also 200 rows from Sheet1 K11 (3 columns) to Sheet2 G2. If you want to add more copy/paste just add this segment:

Set r = Range("K11", Range("K" & Rows.Count).End(xlUp)).SpecialCells(12)
Range(r(1), rWC).Resize(, 3).SpecialCells(12).Copy Sheet2.[G2]

Here's the total macro:

Sub

Sheets("Sheet1").Select

Dim i As Long
Dim r As Range
Dim rWC As Range


Set r = Range("A11", Range("A" & Rows.Count).End(xlUp)).SpecialCells(12)
For Each rWC In r
    i = i + 1
    If i = 200 Or i = r.Count Then Exit For
Next rWC
Range(r(1), rWC).Resize(, 2).SpecialCells(12).Copy Sheet2.[A2]


Set r = Range("K11", Range("K" & Rows.Count).End(xlUp)).SpecialCells(12)
Range(r(1), rWC).Resize(, 3).SpecialCells(12).Copy Sheet2.[G2]


Sheets("Sheet2").Select
Range("A1").Select


End Sub

Select and copy a specific number of filtered rows using VBA in excel

2 Answers2