Copy and paste only filtered data to new workbook

Viewed 57

I copied filtered data from one workbook and pasted the data in new workbook. However, the unfiltered data is also available on the new workbook but it is not visible. Only the filtered data is visible. I want to copy and paste only the filtered data and not having the possibility to select from the unfiltered options. I have the following code below:

Test_Ready.Range(“$A$2:$Q$2”).Autofilter field:=1, Criterial:=Macro_Rules.Range(“CurrentTeam”).Value, Operator:=xlAnd
Test_Ready.Copy Before:=newWB.Sheets(newWB.Worksheets.Count)

Please let me know what I can add to change the outcome. Thank you very much.

1 Answers

You could use advancedFilter:

Option Explicit

Sub CopyFilteredData_Recorded()
  Range("C1:C4").AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:=Range("F1:F2"), _
      CopyToRange:=Range("I1"), Unique:=False
End Sub

Sub FilterAll()
    Range("C1").Select: CopyFilteredData
    Range("C6").Select: CopyFilteredData
    Range("C11").Select: CopyFilteredData
    Range("C16").Select: CopyFilteredData
    Range("C24").Select: CopyFilteredData
    Range("C32").Select: CopyFilteredData
End Sub

Sub CopyFilteredData()
  Dim sourceRange As Range
  Dim destRange As Range
  Set sourceRange = ActiveCell.CurrentRegion
  Set destRange = ActiveCell.Offset(0, 6)
  destRange.CurrentRegion.ClearContents

  sourceRange.AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:=ActiveCell.Offset(0, 3).CurrentRegion, _
      CopyToRange:=destRange, Unique:=False
End Sub

enter image description here

I was not able to replicate the "You can only copy filtered data to the active sheet." error with the macro below ?!
If you want to copy to another worksheet you have to make sure that the destination is the active sheet: (see https://www.extendoffice.com/documents/excel/4585-excel-advanced-filter-to-another-sheet.html#a1 for possible error!)

Option Explicit

Sub Copy_To_Another_Workbook_With_AdvancedFilter()
    Dim SourceWb As Workbook, SourceWs As Worksheet
    Dim TargetWb As Workbook, TargetWs As Worksheet
    Dim Test_Ready As Worksheet, Macro_Rules As Worksheet
    
    Set SourceWb = Workbooks(1)           'define as needed
    Set SourceWs = SourceWb.Sheets(1)     'define as needed
    Set TargetWb = Workbooks(2)           'define as needed
    Set Test_Ready = SourceWs             'define as needed
    Set Macro_Rules = SourceWb.Sheets(2)  'define as needed
    
    TargetWb.Activate
    TargetWb.Sheets.Add Before:=TargetWb.Sheets(TargetWb.Sheets.Count)
    Set TargetWs = ActiveSheet
    
    'not able to replicate the
    '   "You can only copy filtered data to the active sheet."
    '
    TargetWb.Sheets(1).Select
    SourceWb.Activate
    
    'Test_Ready.Range(“$A$2:$Q$2”).Autofilter field:=1, _
    '  Criterial:=Macro_Rules.Range(“CurrentTeam”).Value, Operator:=xlAnd
    'Test_Ready.Copy Before:=newWb.Sheets(newWb.Worksheets.Count)
    
    Test_Ready.Range("A2").CurrentRegion. _
        AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Macro_Rules.Range("CurrentTeam"), _
        CopyToRange:=TargetWs.Range("A1"), Unique:=False
End Sub
Related