先进的过滤器循环

Question

我想建立一个循环，选择一个数组中的不同名称，并在高级过滤器中使用它们，将过滤后的数据复制到不同的工作表。调试说：过滤器的问题（我使用录制工具）。

最后的想法是将过滤后的数据复制到Outlook电子邮件中，尽管如此，还是有点远。

任何想法为什么它不工作？

Private Sub loopfilter() 

Dim VersandRange As Range 
Dim rng As Range 
Dim Name As String 

Set VersandRange = Range("J2", Cells(Rows.Count, "j").End(xlUp)) 

    For Each rng In VersandRange 

     Worksheets("Filtro").Range("AK2") = rng.Value 
     Application.CutCopyMode = False 
     Worksheets("Alle gemahnten Posten (2)").Range("A1").CurrentRegion.AdvancedFilter Action _ 
     :=xlFilterCopy, CriteriaRange:=Range("A1:AK2"), CopyToRange:=Range("A5"), _ 
     Unique:=False 

     Range("a5").CurrentRegion.Copy 

     Worksheets.Add.Name = rng.Value 

     ActiveSheet.Range("A1").Paste 

    Next 

End Sub 

更新1：

非常感谢您的提示

从来就一直在努力使今天早上上班，适应引用。到目前为止，它看起来像这样：

Private Sub loopfilter() 

Dim thisWB As Workbook 
Dim filterws As Worksheet 
Dim howto As Worksheet 
Dim advfilter As Range 
Dim Postenws As Worksheet 
Dim VersandRange As Range 
Dim rng As Range 
Dim Name As String 

Set thisWB = ThisWorkbook 
Set filterws = thisWB.Sheets("Filtro") 
Set howto = thisWB.Sheets("How to") 
Set advfilter = filterws.Range("A1:AK2") 
Set Postenws = thisWB.Sheets("Alle gemahnten Posten (2)") 
Set VersandRange = howto.Range("J2", Cells(Rows.Count, "j").End(xlUp)) 

Dim newWS As Worksheet 

    For Each rng In VersandRange 
     filterws.Range("AK2") = rng.Value 
     Application.CutCopyMode = False 
     Postenws.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _ 
                  CriteriaRange:=advfilter, _ 
                  CopyToRange:=filterws.Range("A5"), _ 
                  Unique:=False 
     filterws.Range("a5").CurrentRegion.Copy 
     Set newWS = thisWB.Sheets.Add 
     newWS.Name = rng.Value 
     newWS.Range("A1").Paste 
    Next 

我正在for循环内的最后2行遇到麻烦。

从来就试了一下作为

Name = rng.value 
newWS.Name = Name 

，但仍然没有工作。有任何想法吗？

Answer 1

代码良好的开端。我将提出一些建议，以帮助您避免在调试时遇到一些困难。

1. 定义和设置引用Worksheets和Workbooks。当您尝试扩展您的工作时，这将有助于您稍后避免出现问题。

2. 通过为数据的来源和发生位置定义描述性名称来帮助自己。

我的猜测是，你的问题（S）正在发生，因为你的Ranges不specifiying使用哪个Worksheet。参阅下面的一个例子：

Option Explicit 

Private Sub loopfilter() 
    Dim VersandRange As Range 
    Dim rng As Range 
    Dim Name As String 

    Dim thisWB As Workbook 
    Dim filterWS As Worksheet 
    Dim postenWS As Worksheet 
    Dim advFilter As Range 
    Set thisWB = ThisWorkbook 
    Set filterWS = thisWB.Sheets("Filtro") 
    Set postenWS = thisWB.Sheets("Alle gemahnten Posten (2)") 
    Set advFilter = filterWS.Range("A1:AK2") 

    Set VersandRange = postenWS.Range("J2", _ 
          postenWS.Cells(postenWS.Rows.Count, "j").End(xlUp)) 

    Dim newWS As Worksheet 
    For Each rng In VersandRange 
     filterWS.Range("AK2") = rng.Value 
     Application.CutCopyMode = False 
     postenWS.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _ 
                  CriteriaRange:=advFilter, _ 
                  CopyToRange:=filterWS.Range("A5"), _ 
                  Unique:=False 
     filterWS.Range("a5").CurrentRegion.Copy 
     Set newWS = thisWB.Sheets.Add 
     newWS.Name = rng.Value 
     newWS.Range("A1").Paste 
    Next 

End Sub