CODEWITHSUNDEEP
vbaexcel
TwoHeartedKale
TwoHeartedKale

Reputation: 51

VBA Copy Paste Loop Not Executing Correctly

I've had a piece of code for a VBA copy-paste loop that I've used for a year and half without any issues that is suddenly not executing correctly. The intent is to take a specific column with a few unique values, and copy paste those filters into new sheets that take the name of unique values. Now there suddenly appears to be a problem with the filtering part of this - when I run the macro it executes without any errors, but completely fails to actually copy and paste anything or create any new sheets. The one thing that DOES happen is copying the unique values into the CO column, but the subsequent loop isn't working right for some reason.

As far as I can tell there have been no inadvertent changes in my code or in the formatting of the reports that I run this with (daily, dynamic ranges) so I'm really stumped on what could possibly be different all of the sudden.

Specifically, the range of values to be copied is A1:CN with a dynamic number of rows and the column with the unique values to be filtered is U. Any ideas why it might not be working?

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

Upvotes: 0

Views: 549

Answers (1)

Shai Rado
Shai Rado

Reputation: 33692

You are relying in your code on ActiveSheet, all of your objects, such as Set rng = Range("A1:CN" & LR), and Range("U1:U" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("CO1"), Unique:=True are not qualified with a worksheet.

You need to add a With Worksheets("Sheet1") statement at the beginning of your code, then qualify all the nested objects with a ., and it should work fine.

Code 

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

Upvotes: 1

Related Questions