僅將過濾后的數據復制並粘貼到新工作簿

Question

我從一個工作簿復制過濾數據並將數據粘貼到新工作簿中。 但是，未過濾的數據在新工作簿上也可用，但不可見。 只有過濾后的數據是可見的。 我只想復制和粘貼過濾后的數據，而無法從未過濾的選項中進行選擇。 我有以下代碼：

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)

請讓我知道我可以添加什么來改變結果。 非常感謝。

Answer 1

您可以使用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

我無法復制“您只能將過濾后的數據復制到活動工作表”。 下面的宏出錯了？！
如果要復制到另一個工作表，則必須確保目標是活動工作表：（請參閱https://www.extendoffice.com/documents/excel/4585-excel-advanced-filter-to-another-sheet .html#a1可能的錯誤！）

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