0
votes

I've been using AdvancedFilter to look through a worksheet, then copy and paste rows that meet criteria into another worksheet. (AdvancedFilter successfully works as it should).

I'm now wondering if it's possible to copy additional rows during each AdvancedFilter positive identification.

For example, every time AdvancedFilter finds a value that meets the pre-defined criteria, can it copy the 12 rows below that row and bring those with it to the other worksheet?

Here's my successful AdvancedFilter code:

Sheet4.Range("A1:X10000").AdvancedFilter , CriteriaRange:=Sheet5.Range("B4:B5"), CopyToRange:=Sheet5.Range("A10:X10"), Unique:=False

An alternative might be to use a for and if loop, which I've tried, but I keep getting a 1004 error or 9 error.

any suggestions?

Here's my loop code:

Sheet4.Select

Dim r As Long, endRow As Long, PasteRowIndex As Long

endRow = 100
PasteRowIndex = 11

For r = 2 To endRow

    If Cells(r, Columns("A").Column).Value = "Test" Then
        Rows(r).Select
        Selection.Copy

        Sheets("CompanyFilter").Select
        Rows(PasteRowIndex).Select
        ActiveSheet.Paste

        PasteRowIndex = PasteRowIndex + 1

        Sheet4.Select
    End If
Next r
1
You should share your loop code and which line is getting the error.Chrismas007
Would the other 12 rows be filtered in or out of that particular filter?Raystafarian
Please edit your question to include your code.Raystafarian
The other 12 rows would not be filtered. They'd just need to be copied.user5037261
If you apply an advanced filter, why not just filter it to a new location rather than in place? It would include everything that hasn't been filtered out.Raystafarian

1 Answers

0
votes

I think this should do it for you -

Sub test()

Dim wsOrig As Worksheet
Set wsOrig = ActiveSheet

Dim wsDest As Worksheet
Set wsDest = Sheets("CompanyFilter")
Dim r As Long, endRow As Long, PasteRowIndex As Long

endRow = 100
PasteRowIndex = 11

For r = 2 To endRow

    If Cells(r, "A").Value = "Test" Then
        For i = r To r + 11
            wsDest.Range("A" & PasteRowIndex).EntireRow = wsOrig.Range("A" & i).EntireRow
            PasteRowIndex = PasteRowIndex + 1
        Next
    r = r + 11
    End If
Next
End Sub