VBAコピー貼り付けループが正しく実行されない

Question

突然正しく実行されない問題がなく、1年半使用したVBAのコピー貼り付けループのコードがあります。その目的は、いくつかの一意の値を持つ特定の列を取り出し、それらのフィルターを一意の値の名前を持つ新しいシートにコピーしてコピーすることです。マクロを実行すると、エラーが発生しなくても実行されますが、実際に何かをコピーアンドペーストしたり、新しいシートを作成したりすることはできません。 1つのことは、一意の値を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

すべてのExcelシートを閉じてから再開すると解決します。しかし、なぜこれがどうして起こったのか誰かが知っていれば、私は不思議です。 Excelのメモリが不足している場合、コード自体が切り詰められる問題はありますか？

Answer 2

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