Results 1 to 9 of 9
  1. #1
    Lounger
    Join Date
    Apr 2014
    Posts
    36
    Thanks
    2
    Thanked 1 Time in 1 Post

    Copy filtered rows from several sheets to one sheet

    Hello,

    I have a file with several sheets with filters and I need to copy the filtered rows (according the filter applied) from all sheet to one sheet only.

    The code that I'm using is:
    -----------------------------
    Option Explicit
    Sub CopyFilters()

    ' Path - modify as needed but keep trailing backslash
    Const sPath = "D:\Documents\"

    Dim sFile As String
    Dim wbkSource As Workbook
    Dim wbkTarget As Workbook
    Dim wSource As Worksheet
    Dim wTarget As Worksheet
    Dim wsName As String
    Dim rngFiltered As Range
    Dim rngTarget As Range
    Dim oFSO As Object
    Dim oFolder As Object
    Dim oSubFolder As Object

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sPath)
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    'Ask worksheet name to copy
    wsName = InputBox("Enter month")
    If wsName = vbNullString Then
    MsgBox "You cancelled!"
    Exit Sub
    End If

    Set wbkTarget = ActiveWorkbook
    Set wTarget = ActiveSheet

    For Each oSubFolder In oFolder.SubFolders
    sFile = Dir(oSubFolder & "\FileName*.xlsx") 'UPDATE File name or part of it

    Do While Not sFile = ""
    Set wbkSource = Workbooks.Open(Filename:=oSubFolder & "\" & sFile, AddToMRU:=False)
    Set wSource = wbkSource.Worksheets(wsName)

    'Copy Sheet to open workbook and rename sheet to the tech name (cell C3)
    'MKT sheet must be always in the workbook
    Sheets(wsName).Copy Before:=wbkTarget.Sheets("MKT")
    ActiveSheet.Name = Range("C3").Value

    wbkSource.Close SaveChanges:=False
    sFile = Dir

    Loop
    Next

    For Each wTarget In Worksheets

    'Unprotect sheets
    wTarget.Unprotect Password:="Password"

    Next wTarget

    'Filter Outra Zona all sheets
    For Each wTarget In Worksheets

    If wTarget.Name <> "MKT" Then
    wTarget.Range("B7:K7").AutoFilter Field:=8, Criteria1:="zone"

    End If

    Next wTarget



    ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

    ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler

    End Sub

    -----------------------------

    Many thanks


    LL

  2. #2
    New Lounger
    Join Date
    Feb 2011
    Posts
    12
    Thanks
    0
    Thanked 3 Times in 2 Posts
    I suggest you use Advanced Filter rather than Autofilter.

    Insert a few rows above the data you want to filter and copy your column headers to the first row of this space. In the second row in column H (=column 8), type the criteria as follows:
    ="zone"

    In this example, I've used rows 1 and 2 so the headers were copied onto row 1 and the ' ="zone" ' bit is in cell H2. The data headers are in B7:K7 and the data is in rows 8 to 27.

    Now replace your autofilter line with something like the following, adapting it to your cell ranges and sheet names:

    wTarget.Range("B7:K27").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
    "H1:H2"), CopyToRange:=Range("Sheet3!A1"), Unique:=False

    That should filter any records that have 'zone' in column H for any entries from rows 8 to 27 then copy them to Sheet3, starting at cell A1.

  3. #3
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 341 Times in 334 Posts
    You are copying an entire worksheet in your code, not the filtered range. To copy the filtered range you can use:
    If wTarget.Name <> "MKT" Then
    wTarget.Range("B7:K7").AutoFilter Field:=8, Criteria1:="zone"
    wTarget.Range("B7:Kx").copy
    End If


    Where x is the last row of your data range...


    Then you will have to paste it somewhere (you don't indicate in your code where you want to paste it).

    Steve
    Last edited by sdckapr; 2014-07-17 at 10:00. Reason: forgot to expand for last row

  4. #4
    Lounger
    Join Date
    Apr 2014
    Posts
    36
    Thanks
    2
    Thanked 1 Time in 1 Post
    Hi Steve,

    Thanks for the reply.

    The filtered rows from each sheet is to paste in the sheet "MKT", starting in cell B8.

    I've tried the following code:

    For Each wTarget In Worksheets
    If wTarget.Name <> "MKT" Then
    wTarget.Range("B7:K7").AutoFilter Field:=8, Criteria1:="zone"
    wTarget.Range("B8:K258").Copy _
    wTarget("MKT").Cells(lMaxTargetRow + 1, 1)
    End If
    Next wTarget

    But I'm getting this ERROR: Object downs't support this property or method.

    I do not neet to copy the headers because they are already in the target sheet "MKT"

    Can you please help? Thanks

    LL

  5. #5
    Bronze Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    1,200
    Thanks
    46
    Thanked 228 Times in 211 Posts
    Lucia,

    In the line

    wTarget("MKT").Cells(lMaxTargetRow + 1, 1)

    wTarget is the active sheet and cannot accept a name parameter. Try changing the line to

    Worksheets("MKT").Cells(lMaxTargetRow + 1, 1) and have it do something like:

    Code:
    For Each wTarget In Worksheets 
       If wTarget.Name <> "MKT" Then
          wTarget.Range("B7:K7").AutoFilter Field:=8, Criteria1:="zone"
          wTarget.Range("B8:K258").Copy 
          Worksheets("MKT").Activate
          Worksheets("MKT").Cells(lMaxTargetRow + 1, 1).select
          Activesheet.paste
          wTarget.Activate
       End If 
    Next wTarget
    Note: code is untested
    Last edited by Maudibe; 2014-07-19 at 08:01. Reason: added code

  6. #6
    Bronze Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    1,200
    Thanks
    46
    Thanked 228 Times in 211 Posts
    Lucia,

    If you can't get the above code to work, you can incorporate the following code into yours. It will cycle through the sheets, filter each sheet according to your parameters, and copy each filtered row to the MKT sheet appending them sequentially. It will also disable the filters upon completion and re-protect the worksheets.

    HTH,
    Maud

    Code:
    Public Sub CopyRows()
    Application.ScreenUpdating = False
    '--------------------------------------------
    'DECLARE AND SET VARIABLES
    Dim targetrow As Range
    Dim sourcerow As Integer
    sourcerow = 3
    '--------------------------------------------
    'CYCLE THROUGH WORKSHEETS
    With Worksheets("MKT")
    For I = 1 To Worksheets.Count
        Worksheets(I).Unprotect Password:="Password"
        If Worksheets(I).Name <> "MKT" Then
        Worksheets(I).Activate
        '----------------------------------------
        'FILTER SHEET AND COPY ROWS TO MKT
            Worksheets(I).Range("B7:K7").AutoFilter Field:=8, Criteria1:="zone"
            LastRow = ActiveSheet.Cells(Rows.Count, 9).End(xlUp).row
            For Each targetrow In Worksheets(I).Range("B8:K" & LastRow).Rows
                If targetrow.Hidden = False Then
                    For J = 2 To 11
                        .Cells(sourcerow, J - 1) = Cells(targetrow.row, J)
                    Next J
                    sourcerow = sourcerow + 1
                End If
            Next targetrow
        '---------------------------------------
        'TURN OFF FILTER AND PROTECT SHEET
            Range("I9").AutoFilter
            Worksheets(I).Protect Password:="Password"
        End If
    Next I
    End With
    Application.ScreenUpdating = True
    End Sub

  7. #7
    Lounger
    Join Date
    Apr 2014
    Posts
    36
    Thanks
    2
    Thanked 1 Time in 1 Post
    Thanks for the info Maudibe

    The copy process is ok but the paste is not.

    Meaning:
    1) copy the filtered rows from the 1st sheet and paste it ok in sheet MKT starting on cell A1
    2) copy the filtered rows from the 2nd sheet and paste it on top of the already pasted rows, i.e. starting again on Cell A1

    What I need is to pasted the filtered rows from the 2nd sheet in the next available row.

    How can I do that?

    Many thanks in advance for your help



    LL

  8. #8
    Bronze Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    1,200
    Thanks
    46
    Thanked 228 Times in 211 Posts
    Luciat,

    To the code in which post are you referring to?

  9. #9
    Lounger
    Join Date
    Apr 2014
    Posts
    36
    Thanks
    2
    Thanked 1 Time in 1 Post
    Sorry Maudibe but I didn't see the 2nd post

    But works jst fine

    Many thanks for your help.


    LL

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •