Excel VBA Autofilter Copy Paste Into New Named Sheets

Question

I have a column (B) with a number of different unique values that I need to filter, copy paste into new sheets named for those values. I've successfully done this in another workbook but I'm having trouble getting it working in this case, I think because there are several blanks in the column. Even when I filled in the blanks with dummies it breaks at the same place (6th line) because of a run time error 1004: "The extract range has a missing or invalid field name". Here's the code I have for that section:

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

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

    Range("B1:B" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("BF1"), Unique:=True

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

Any ideas how to troubleshoot this? For reference BF is the last column with data, and the number of rows is variable as this is a daily report.

Thanks!

Does your CopyToRange have the same heading as the data range? — Dan
Yes, I think so but I'm not super clear on what's happening here. It still breaks at the same place every time. — TwoHeartedKale

user3598756 user3598756 · Accepted Answer · 2016-04-10T16:29:32

I think Dan's clue is the one to go: you must ensure that cell "BF1" either is blank or is filled with the same value as cell "B1" one.

One way could be deleting cell "BF1" content right before the .Autofilter statement.

Finally also you must take care for blank cells in column "B", since they'd ask for a blank sheet name which would throw an error.

so you could try like follows

Option Explicit

Sub main()

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

    LR = Cells(Rows.Count, "R").End(xlUp).row
    Set rng = Range("A1:BF" & LR)

    Range("BF1").ClearContents '<== ensure possible "BF1" cell content wouldn't match "B1" cell value

    Range("B1:B" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("BF1"), Unique:=True

    For Each c In Range([BF2], Cells(Rows.Count, "BF").End(xlUp))
        With rng
            .AutoFilter
            .AutoFilter Field:=2, Criteria1:=c.value
            .SpecialCells(xlCellTypeVisible).Copy
            Sheets.Add(After:=Sheets(Sheets.Count)).Name = IIf(c.value = "", "Blank Key", c.value) '<== handle "blank" Key
            ActiveSheet.Paste
        End With
    Next c
End Sub

Excel VBA Autofilter Copy Paste Into New Named Sheets

1 Answers