アドバンスフィルタから貼り付け

Question

私は一線を越えていますが、エラーの解決方法はわかりません。私は、高度なフィルタで異なる名前をフィルタリングし、個々のシートにデータをコピーすることによってリスト内の行を分割していますが、次の行の最後の行にはまっています： "newWS.Range（" A1 "）。 "デバッグからエラー1004が発生します。

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 

End Sub 

なぜ機能しないのでしょうか？

おかげ

Answer 1

はこれを試してみてください（もVersandrangeのあなたの定義にシート参照を行いました）。ペーストは範囲オブジェクトのメソッドではありません。

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", howto.Cells(Rows.Count, "j").End(xlUp)) 

Dim newWS As Worksheet 

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

End Sub