CODEWITHSUNDEEP
excelvba
Dan-DH
Dan-DH

Reputation: 19

Copy filtered information

I want to copying information from two different workbooks into a third. The code below works for B, but for A it pastes only the first row of information.

I set the destination for A to a different tab of the source workbook and it worked. Then I set the destination to a newly created workbook, and also worked.

When I tried again with the workbook I want the information in, it pastes only the first row.

'open file A
    Set W_Book = Workbooks.Open(Folder_Path & A_Rep)
    Sheets("A").Activate
'filter out information and copy it
    With ActiveSheet
        .AutoFilterMode = False
        .UsedRange.AutoFilter
        .UsedRange.AutoFilter Field:=5, Criteria1:=Start_Date
        .UsedRange.AutoFilter Field:=10, Criteria1:="AAA10"
        .UsedRange.SpecialCells(xlCellTypeVisible).Copy
    End With

'paste on the tracker and close the report
    Windows("Tracker.xlsm").Activate
    Sheets("Sheet A").Range("A1").PasteSpecial
    W_Book.Close False

'open file B
    Set W_Book = Workbooks.Open(Folder_Path & B_Rep)

'filter out information and copy it
    With ActiveSheet
        .AutoFilterMode = False
        .UsedRange.AutoFilter
        .UsedRange.AutoFilter Field:=7, Criteria1:="BBB10" 
        .UsedRange.AutoFilter Field:=24, Criteria1:="Done"
        .UsedRange.SpecialCells(xlCellTypeVisible).Copy
    End With

'paste on the tracker and close the report
    Windows("Tracker.xlsm").Activate
    Sheets("Sheet B").Range("A1").PasteSpecial
    W_Book.Close False

Upvotes: 0

Views: 48

Answers (1)

Xabier
Xabier

Reputation: 7735

This is happening because you are using ActiveSheet when filtering the data, but after you open workbook B, you don't specify a sheet to copy, try the code below and it should give you better results, I specified the first worksheet to copy data from, which you may need to amend:

Sub foo()
Dim wbTracker As Workbook: Set wbTracker = Workbook("Tracker.xlsm")
'open file A
    Set W_Book = Workbooks.Open(Folder_Path & A_Rep)
'filter out information and copy it
    With W_Book.Sheets("A")
        .AutoFilterMode = False
        .UsedRange.AutoFilter
        .UsedRange.AutoFilter Field:=5, Criteria1:=Start_Date
        .UsedRange.AutoFilter Field:=10, Criteria1:="AAA10"
        .UsedRange.SpecialCells(xlCellTypeVisible).Copy
    End With

'paste on the tracker and close the report
    wbTracker.Sheets("Sheet A").Range("A1").PasteSpecial
    W_Book.Close False

'open file B
    Set W_Book = Workbooks.Open(Folder_Path & B_Rep)

'filter out information and copy it
    With W_Book.Sheets(1)
        .AutoFilterMode = False
        .UsedRange.AutoFilter
        .UsedRange.AutoFilter Field:=7, Criteria1:="BBB10"
        .UsedRange.AutoFilter Field:=24, Criteria1:="Done"
        .UsedRange.SpecialCells(xlCellTypeVisible).Copy
    End With

'paste on the tracker and close the report
    wbTracker.Sheets("Sheet B").Range("A1").PasteSpecial
    W_Book.Close False
End Sub

Upvotes: 1

Related Questions