复制自动过滤范围，vba excel

Question

我编写了执行以下操作的代码：

1. 对选定workbook 中的特定sheet 应用自动过滤器
2. 将数据从autofiltered range复制到另一个workbook

代码如下：

 m = 2 
 For i = 1 To work_book.Worksheets.Count 
With work_book.Sheets(i) 
    If (.UsedRange.Rows.Count > 1) Then 
         'apply filters
        .UsedRange.AutoFilter field:=2, Criteria1:=array_of_account_numbers, Operator:=xlFilterValues 
        .UsedRange.AutoFilter field:=1, Criteria1:=array_of_debit_or_credits, Operator:=xlFilterValues 
         'select only visible cells after autofilter is applied
        On Error Goto a 
        m = destination_workbook.Sheets(1).UsedRange.Rows.Count + 1 
        Intersect(.UsedRange, .UsedRange.Offset(1)).SpecialCells(xlCellTypeVisible).Copy destination_workbook.Sheets(1).Range("A" & m) 
 a: 
    End If 
   End With 

但是，宏会持续复制一些垃圾。这意味着除了autofiltered range 之外，它还从每个sheet 前三个rows 复制。

我该如何解决这个问题？感谢您的帮助和回答。

编辑

这是工作表中数据的示例

过滤器应用于 Criteria1 ( 60, 50) 和 Criteria2 (1470, 1450)

Answer 1

.UsedRange 将获取源工作表上的所有数据，而不仅仅是自动过滤结果下方的数据。

您在 Intersect...Copy 语句中使用的 Offset 应该是您要忽略的自动过滤结果上方的行数，而不是值 1。

如果你知道你有多少标题行：

numHeaderRows = 5
For i = 1 To work_book.Worksheets.Count 
  With work_book.Sheets(i) 
    If (.UsedRange.Rows.Count > 1) Then 
         'apply auto-filters starting at the row directly above the start of the data.
        .UsedRange.Offset(numHeaderRows-1).AutoFilter field:=2, Criteria1:=array_of_account_numbers, Operator:=xlFilterValues 
        .UsedRange.Offset(numHeaderRows-1).AutoFilter field:=1, Criteria1:=array_of_debit_or_credits, Operator:=xlFilterValues 
         'select only visible cells after autofilter is applied
        On Error Goto a 
        m = destination_workbook.Sheets(1).UsedRange.Rows.Count + 1 
        Intersect(.UsedRange, .UsedRange.Offset(numHeaderRows)).SpecialCells(xlCellTypeVisible).Copy destination_workbook.Sheets(1).Range("A" & m) 
  a: 
    End If 
  End With
Next