Excel VBA Autofilter Kopieren Einfügen in neue benannte Blätter

Question

Ich habe eine Spalte (B) mit einer Reihe von verschiedenen eindeutigen Werten, die ich filtern muss, kopieren Sie die Paste in neue Blätter für diese Werte benannt. Ich habe das erfolgreich in einem anderen Arbeitsbuch getan, aber ich habe Probleme, es in diesem Fall zu arbeiten, denke ich, weil es mehrere Leerzeichen in der Spalte gibt. Auch wenn ich die Lücken mit Dummies ausgefüllt habe, bricht es an der gleichen Stelle (6. Zeile) wegen eines Laufzeitfehlers 1004: "Der Extraktbereich hat einen fehlenden oder ungültigen Feldnamen". Hier ist der Code, den ich für diesen Abschnitt habe:

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 

Irgendwelche Ideen, wie Sie dies beheben? Als Referenz ist BF die letzte Spalte mit Daten und die Anzahl der Zeilen ist variabel, da es sich um einen täglichen Bericht handelt.

Danke!

Answer 1

Ich denke, Dans Hinweis ist der eine zu gehen: Sie müssen sicherstellen, dass die Zelle "BF1" entweder leer ist oder mit dem gleichen Wert wie Zelle "B1" gefüllt ist.

Eine Möglichkeit könnte Zell "BF1" Inhalt direkt vor der .Autofilter Anweisung löschen.

Schließlich müssen Sie auch auf leere Zellen in Spalte "B" achten, da sie nach einem leeren Blattnamen fragen würden, der einen Fehler verursachen würde.

so könnten Sie versuchen, wie

folgt

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