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

粘贴来自高级过滤器

1 个答案: