VBAのオートフィルターを使ってCSV出力を行いたい

Question

前提・実現したいこと

VBAを利用してExcelの値をCSVに出力するプログラムを作成しています。
オートフィルターを利用してB列の絞込を行いながら順番に出力していきたいです。

例えば下記のような表があったときは列2の情報（東京都・愛知県・大阪府）で絞込を順に行い、別々のCSVとしてその行の情報を出力したいと思っています。

列1	列2	列3	列4	列5
1	東京都	Aさん	女	23歳
2	愛知県	Bさん	男	53歳
3	東京都	Cさん	男	29歳
4	大阪府	Dさん	女	31歳
5	愛知県	Eさん	男	48歳
6	大阪府	Fさん	女	12歳

###実現イメージ

東京都.csv

列1	列2	列3	列4	列5
1	東京都	Aさん	女	23歳
3	東京都	Cさん	男	29歳

愛知県.csv

列1	列2	列3	列4	列5
2	愛知県	Bさん	男	53歳
5	愛知県	Eさん	男	48歳

大阪府.csv

列1	列2	列3	列4	列5
4	大阪府	Dさん	女	31歳
6	大阪府	Fさん	女	12歳

発生している問題・エラーメッセージ

実際にコードを書いて出力したところ、各県の名称のファイルが出力されたものの、セルの絞込がクリアできていないのか、

東京都⇒東京都のみのデータ（想定通り）
愛知県⇒東京都と愛知県のデータ（想定通りではない）
大阪府⇒東京都と愛知県と大阪府のデータ（想定通りではない）

上記のように出力されてしまいます。

セルのクリアがうまくいっていないか、検索で変数を入れるところがうまく実装できていないかと思うのですが、VBAは初心者でありよくわからなかったので、皆様のお力をお借りしたいと思っています。

よろしくお願いいたします。

該当のソースコード

      Dim cmax
      Dim csvFile As String
      Dim i As Integer
                    
      SaveDir = ThisWorkbook.Path

      'B列の最終行の数を取得
      cmax = Worksheets("active").Range("B65536").End(xlUp).row
      


      '最終行まで繰り返す
      For i = 2 To cmax

            Dim atai As String
            'ataiにフィルターの絞込を行っている単語を入れる
            If atai <> Worksheets("active").Range("B" & i).Value Then
                  atai = Worksheets("active").Range("B" & i).Value
            End If

           '「フィルターの絞込を行っている単語名.csv」の名称のファイルをカレントディレクトリに作成する
            csvFile = SaveDir & "\" & atai & ".csv"
            
                '高さをカウント
                lngRowMax = Range("$A$" & Rows.Count).End(xlUp).row


                '書き込みを行うファイルを開く
                Open csvFile For Output As #1

                        'フィルターの絞込がされていたら解除する
                        If ActiveSheet.FilterMode = True Then
                        ActiveSheet.ShowAllData
                        End If
                        
                        'ataiの単語でB列のフィルター動作させる
                        ActiveWorkbook.Worksheets("active").Range("A2:E" & cmax).AutoFilter Field:=2, Criteria1:=atai

                        Dim j As Long
                        For j = 1 To 5
                           '1行目の各列のタイトルを書き込む
                           Print #1, ActiveSheet.Cells(1, j).Value&; ",";
                        Next j
                        '改行
                        Print #1, vbCr;
                            
                        Dim c As Long, k As Long
                        
                        For c = 2 To lngRowMax
                            For j = 1 To 5
                                '絞り込んだデータを基にCSV書き込みを行う
                                Print #1, ActiveSheet.Cells(c, j).Value&; ",";
                            Next j
                            '改行
                            Print #1, ActiveSheet.Cells(c, j).Value & vbCr;
                        Next c
                'ファイルを閉じる
                Close #1

     '次の行に行く
      Next i

     'フィルターの絞込を解除する（全件表示）
     If ActiveSheet.FilterMode = True Then
           ActiveSheet.ShowAllData
     End If

Answer 1

オートフィルターされたセルを扱うのは、いろいろと落とし穴がありそうですね。
http://officetanaka.net/excel/vba/tips/tips155.htm
を参考にすると、オートフィルターされている結果を他のシートにコピーするのが１番確実なようです。
作業用のシートとして"作業用"というシートを作成しておきます。
そちらにオートフィルターされている結果をコピーした後、"作業用"シートの内容をCSVに出力します。

Public Sub CSV_WithAutoFilter1()
    Dim maxrow As Long
    Dim maxrow2 As Long
    Dim wrow As Long
    Dim ws As Worksheet
    Dim ws2 As Worksheet
    Dim dicT As Object
    Dim key As Variant
    Dim csvFile As String
    Dim SaveDir As String
    Dim cr As Range
    Dim str As String
    SaveDir = ThisWorkbook.Path
    Set dicT = CreateObject("Scripting.Dictionary")    ' 連想配列の定義
    Set ws = Worksheets("active")
    Set ws2 = Worksheets("作業用")
    ws.AutoFilterMode = False                       'オートフィルタ解除
    maxrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    '都道府県単位のキーを集計
    For wrow = 2 To maxrow
        key = ws.Cells(wrow, "B").Value
        dicT(key) = True
    Next
    '全キー分繰り返す
    For Each key In dicT.keys
        '「フィルターの絞込を行っている単語名.csv」の名称のファイルをカレントディレクトリに作成する
        csvFile = SaveDir & "\" & key & ".csv"
        '書き込みを行うファイルを開く
        Open csvFile For Output As #1
        ws.AutoFilterMode = False
        'オートフィルタ設定
        ws.Range("A1").AutoFilter Field:=2, Criteria1:=key
        ws2.Cells.ClearContents
        ws.Range("A1").CurrentRegion.Copy ws2.Range("A1")
        '表示されている全行を処理する
        maxrow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
        For wrow = 1 To maxrow2
            Dim j As Long
            For j = 1 To 5
                str = ws2.Cells(wrow, j).Value
                If j <> 5 Then
                    Print #1, str; ",";
                Else
                    Print #1, str; vbCrLf;
                End If
            Next
        Next
        Close #1
    Next
    ws.AutoFilterMode = False
    MsgBox ("完了")
End Sub

尚、作業用のシートは作りたくないということであれば、こちらの方法もあります。
たまたま、こちらでうまくいっただけで、他の環境で正しく動作するかどうかはわかりませんが、
参考までに。

Public Sub CSV_WithAutoFilter2()
    Dim maxrow As Long
    Dim wrow As Long
    Dim ws As Worksheet
    Dim dicT As Object
    Dim key As Variant
    Dim csvFile As String
    Dim SaveDir As String
    Dim cr As Range
    Dim str As String
    SaveDir = ThisWorkbook.Path
    Set dicT = CreateObject("Scripting.Dictionary")    ' 連想配列の定義
    Set ws = Worksheets("active")
    ws.AutoFilterMode = False                       'オートフィルタ解除
    maxrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    '都道府県単位のキーを集計
    For wrow = 2 To maxrow
        key = ws.Cells(wrow, "B").Value
        dicT(key) = True
    Next
    '全キー分繰り返す
    For Each key In dicT.keys
        '「フィルターの絞込を行っている単語名.csv」の名称のファイルをカレントディレクトリに作成する
        csvFile = SaveDir & "\" & key & ".csv"
        '書き込みを行うファイルを開く
        Open csvFile For Output As #1
        ws.AutoFilterMode = False
        'オートフィルタ設定
        ws.Range("A1").AutoFilter Field:=2, Criteria1:=key
        '表示されている全行を処理する
        For Each cr In ws.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)
            wrow = cr.Row
            Dim j As Long
            For j = 1 To 5
                str = ws.Cells(wrow, j).Value
                If j <> 5 Then
                    Print #1, str; ",";
                Else
                    Print #1, str; vbCrLf;
                End If
            Next
        Next
        Close #1
    Next
    ws.AutoFilterMode = False
    MsgBox ("完了")
End Sub

Answer 2

Option Explicit

Sub test()
    Dim rngData As Range
    Dim rngList As Range
    Dim rngConditions As Range
    Dim rngResult As Range
    Dim c As Range
    
    'セル範囲指定
    With ThisWorkbook
        Set rngData = .Worksheets(1).UsedRange
        Set rngList = .Worksheets(2).Range("A1")
        Set rngConditions = Worksheets(2).Range("C1:C2")
        Set rngResult = .Worksheets(3).Range(rngData.Rows(1).Address)
    End With
    
    '準備
    rngList.Worksheet.Cells.ClearContents
    rngConditions(1).Value = rngData(2).Value
    rngResult.Value = rngData.Rows(1).Value
    
    '重複のない抽出項目のリスト作成
    With rngData
        Intersect(.Offset(1), .Columns("B")).Copy rngList
    End With
    rngList.CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlNo
    
    '項目毎に繰り返し
    For Each c In rngList.CurrentRegion
        '抽出条件設定
        rngConditions(2).Value = c.Value
        
        '抽出
        rngData.AdvancedFilter _
            Action:=xlFilterCopy, _
            CriteriaRange:=rngConditions, _
            CopyToRange:=rngResult
        
        'CSVで保存
        rngResult.Worksheet.Copy
        With Workbooks(Workbooks.Count)
            .SaveAs Filename:=ThisWorkbook.Path & "\" & c.Value & ".csv", _
                    FileFormat:=xlCSV
            .Close SaveChanges:=False
        End With
    Next
End Sub

1）フィルターオプションで抽出（別のシートに結果をコピーする機能が内包されている）
2）そのシートを新規ブックにコピー
3）CSV形式で保存

という流れではだめでしょうか？

Answer 3

絞込したい単語選定とオートフィルターしながらCSV作成の２ステップで処理する必要があります。
コードを見直してみましたので、参考にしてください。

Sub hogeCSV()
    Dim csvFile As String
    Dim i As Integer, lngRowMax As Integer

    Dim SaveDir As String
    SaveDir = ThisWorkbook.Path

    '最初に絞込したい単語を選定
    Dim atai As Object
    Set atai = CreateObject("Scripting.Dictionary")

    For i = 2 To Worksheets("active").Range("B65536").End(xlUp).Row
        If Not atai.Exists(Worksheets("active").Range("B" & i).Value) Then
              atai.Add Worksheets("active").Range("B" & i).Value, 0
        End If
    Next i '次の行に行く

    'オートフィルターしながらCSV作成
    Dim v As Variant
    For Each v In atai.Keys
        '「フィルターの絞込を行っている単語名.csv」の名称のファイルをカレントディレクトリに作成する
        csvFile = SaveDir & "\" & v & ".csv"
                
        '書き込みを行うファイルを開く
        Open csvFile For Output As #1

        'フィルターの絞込がされていたら解除する
        If Worksheets("active").FilterMode = True Then
            Worksheets("active").ShowAllData
        End If
        
        '単語でB列のフィルター動作させる
        Worksheets("active").Range("A1:E1").AutoFilter Field:=2, Criteria1:=v

        '高さをカウント
        lngRowMax = Worksheets("active").Range("B" & Rows.Count).End(xlUp).Row

        Dim j As Long
        For j = 1 To 5
            '1行目の各列のタイトルを書き込む
            Print #1, Worksheets("active").Cells(1, j).Value&; ",";
        Next j
        '改行
        Print #1, vbCr; '改行コードは　vbNewline　がよいか。

        Dim c As Long
        For c = 2 To lngRowMax
            For j = 1 To 5
                '絞り込んだデータを基にCSV書き込みを行う
                Print #1, Worksheets("active").Cells(c, j).Value&; ",";
            Next j
            '改行
            Print #1, Worksheets("active").Cells(c, j).Value & vbCr; '改行コードは　vbNewline　がよいか。
        Next c
        'ファイルを閉じる
        Close #1
    Next v

    'フィルターの絞込を解除する（全件表示）
    If Worksheets("active").FilterMode = True Then
        Worksheets("active").ShowAllData
    End If
End Sub