Question

我已经有一段代码用于VBA复制粘贴循环，我已经使用了一年半而没有任何突然没有正确执行的问题。目的是获取具有一些唯一值的特定列，并将这些过滤器复制粘贴到具有唯一值名称的新工作表中。现在突然出现了过滤部分的问题 - 当我运行宏时它执行没有任何错误，但完全无法实际复制和粘贴任何内容或创建任何新表。发生的一件事是将唯一值复制到CO列中，但后续循环由于某种原因不能正常工作。

据我所知，我的代码或报告的格式没有出现意外更改（我每天都在动态范围内），所以我真的难以理解可能会有什么不同突然之间。

具体来说，要复制的值的范围是具有动态行数的A1：CN，而具有要过滤的唯一值的列是U.有什么想法可能无效吗？

Dim rng as Range
Dim c As Range
Dim LR As Long

    LR = Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = Range("A1:CN" & LR)

    Range("U1:U" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("CO1"), Unique:=True

    For Each c In Range([CO2], Cells(Rows.Count, "CO").End(xlUp))
        With rng
            .AutoFilter
            .AutoFilter Field:=21, Criteria1:=c.Value
            .SpecialCells(xlCellTypeVisible).Copy
            Sheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
            ActiveSheet.Paste
        End With
    Next c

Answer 1

您依赖ActiveSheet上的代码，所有对象（例如Set rng = Range("A1:CN" & LR)和Range("U1:U" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("CO1"), Unique:=True）都不符合工作表。

您需要在代码的开头添加With Worksheets("Sheet1")语句，然后使用.限定所有嵌套对象，它应该可以正常工作。

代码

With Worksheets("Shee1") ' <-- you need this line,  modify to your sheet's name

    LR = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set rng = .Range("A1:CN" & LR)

    .Range("U1:U" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("CO1"), Unique:=True

    For Each c In .Range(Range("CO2"), .Cells(.Rows.Count, "CO").End(xlUp))
        With rng
            .AutoFilter
            .AutoFilter Field:=21, Criteria1:=c.Value
            .SpecialCells(xlCellTypeVisible).Copy
            Sheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
            ActiveSheet.Paste
        End With
    Next c
End With

Answer 2

所以 - 在我关闭所有Excel工作表并重新打开后，它自行解决了。但是现在我很好奇是否有人知道为什么会发生这种情况呢？如果Excel内存不足，是否存在代码截断的问题？

VBA复制粘贴循环未正确执行

2 个答案: