Excel VBA AutoFilter添加空行

我已经修改了我的Excelmacros，它之前一行一行，它现在过滤结果和批量复制。 效率更高

现在我遇到的问题，自动筛选器添加到工作表的数百万空行，我无法确定它为什么这样做。

CountryCodes是一个包含filter值的字典。 标准正在寻找包含字典条目的行。

这是代码：

For Each vall In CountryCodes thisWB.Activate thisWB.Sheets("Overall Numbers").Activate lookfor = CountryCodes.Item(vall) rep = Replace(thisWBName, "EMEA", lookfor) Set rng = ActiveSheet.Range("A1:Z1") FilterField = WorksheetFunction.Match("Host", rng.Rows(1), 0) If ActiveSheet.AutoFilterMode = False Then rng.AutoFilter rng.AutoFilter Field:=FilterField, Criteria1:="=*" & lookfor & "*", Operator:=xlFilterValues Set rng2 = ThisWorkbook.Worksheets("Overall Numbers").Cells.SpecialCells(xlCellTypeVisible) rng2.Copy Workbooks(rep).Worksheets("Overall Numbers").Range("A1") Workbooks(rep).Save thisWB.Activate thisWB.Sheets("Overall Numbers").Activate Cells.AutoFilter Next 

Answer 1

testing：

 Dim ur As Range Set ur = ThisWorkbook.Sheets("Overall Numbers").UsedRange Application.ScreenUpdating = False filterField = Application.Match("Host", ur.Rows(1), 0) If Not IsError(filterField) Then For Each vall In countryCodes rep = Replace(thisWBName, "EMEA", vall) ur.AutoFilter Field:=filterField, Criteria1:="=*" & vall & "*" 'copy visible rows with data only ur.SpecialCells(xlCellTypeVisible).Copy 'paste visible rows with data only Workbooks(rep).Worksheets("Overall Numbers").Range("A1").PasteSpecial xlPasteAll Workbooks(rep).Save ur.AutoFilter Next End If Application.ScreenUpdating = True 

Answer 2

我已经重组了你的代码并删除了.Activate依赖，并用Range.CurrentRegion属性隔离了过滤的数据。

 With thisWB With .Worksheets("Overall Numbers") If .AutoFilterMode Then .AutoFilterMode = False lookfor = CountryCodes.Item(vall) rep = Replace(thisWBName, "EMEA", lookfor) With .Cells(1, 1).CurrentRegion FilterField = WorksheetFunction.Match("Host", .Rows(1), 0) For Each vall In CountryCodes .AutoFilter Field:=FilterField, Criteria1:="=*" & lookfor & "*", Operator:=xlFilterValues If CBool(Application.Subtotal(103, .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0))) Then .Copy Workbooks(rep).Worksheets("Overall Numbers").Range("A1") Workbooks(rep).Save End If .AutoFilter Field:=FilterField Next vall End With End With .AutoFilter End With 

除非rep以某种方式增加，否则这似乎粘贴到每个迭代相同的工作簿/工作表/范围。