Excel VBA Autofilter新しい名前付きシートに貼り付けをコピー

Question

私はフィルタリングする必要があるいくつかの異なる固有の値を持つ列（B）を持っています。私は正常に別のワークブックでこれをやったが、私はそれがこの場合に動作するようになっている問題を抱えている、私は列にいくつかの空白があると思う。ブランクをダミーで埋めても、ランタイムエラー1004：「抽出範囲にフィールド名がないか無効です」という理由で、同じ場所（6行目）で破損します。このセクションのコードは次のとおりです。

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 

どのような問題を解決するには？参照のために、BFはデータの最後の列であり、行の数は日常的なレポートであるため可変です。

ありがとうございます！

Answer 1

私はダンの手がかりがあると思います。セル "BF1"が空白か、セル "B1"と同じ値で満たされていることを確認する必要があります。

.Autofilterの直前に、セル「BF1」のコンテンツを削除することも可能です。

最後に、空白のセルを列 "B"に入れる必要があります。空白のセルは、エラーを発生させる空白のシート名を要求するためです。

はそう

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