先進的過濾器循環

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