アクティブシートのリストを指定した列の値ごとに分割してシートに分けるマクロ

アクティブシートのリストを

指定した列の値ごとに

分割してシートに分けるマクロ

コード

Sub リスト分割応用()
    Dim c As Long
    Dim r As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim listLastRow As Long
    Dim filterColumn As Range
    Dim filterValue As String
    Dim lastRow As Long
    Dim i As Long
    Dim ii As Long
    Dim iii As Long
    
    c = InputBox("対象の列が何行目か入力してください" & vbCrLf & "（C列の場合の入力例：3）")
    r = InputBox("タイトルとして残したい行を入力してください" & vbCrLf & "（入力例：2）")
    
    ' アクティブシートを大元のワークシートとして指定
    Set ws1 = ActiveSheet
     ' フィルターをクリア
    ws1.AutoFilterMode = False
    
    'リストシートを作成
    Set ws2 = Sheets.Add
    ws1.Columns(c).Copy Destination:=ws2.Range("A1")
    'リストシートのタイトル行を削除
    For ii = 1 To r
        ws2.Cells(1, ii).EntireRow.Delete
    Next ii
    'リストシートの重複を削除
    ws2.Range("A1").CurrentRegion.RemoveDuplicates Columns:=1
    listLastRow = ws2.Range("A1").CurrentRegion.Rows.Count
    
    '繰り返しの指定
    For i = 1 To listLastRow
    
        ' フィルターの条件を指定（指定の文字列以外を削除）
        filterValue = ws2.Cells(i, 1)
    
        '大元のシートを、最後にコピーする
        ws1.Copy After:=Worksheets(Worksheets.Count)
    
        'コピーしたシートをws3とする
        Set ws3 = Worksheets(Worksheets.Count)
   
        ' フィルターをかける列を指定
        Set filterColumn = ws3.Cells(1, c).EntireColumn
        
        ' 最終行を取得
        lastRow = ws3.Cells(ws3.Rows.Count, filterColumn.Column).End(xlUp).Row
    
        ' オートフィルターモードを有効にしてフィルターを設定
        filterColumn.AutoFilter Field:=1, Criteria1:="<>" & filterValue
    
            ' フィルターされた行を削除
            For iii = lastRow To r + 1 Step -1
                If Not ws3.Cells(iii, filterColumn.Column).EntireRow.Hidden Then
                    ws3.Rows(iii).Delete
                End If
            Next iii
    
    ' オートフィルターモードをクリア
    ws3.AutoFilterMode = False
    
    'ワークシートの名前を変える
    ws3.Name = filterValue
    
    Next i
    
    'リストシートを削除
    Application.DisplayAlerts = False
    ws2.Delete
    
    MsgBox "分割完了"
    
End Sub

利用方法詳細

列は必ず数字で指定すること。
※列選択のときに何も入力されていない列を選ぶとエラーになる。

タイトル行も指定できるコードなので

タイトルとして２行目まで残したい場合にも利用できる

６列目の性別で分割、タイトルは２行目まで残した場合


いろんな場面で使える汎用性の高いコード。
列とタイトル行を固定したい場合は以下を参照。
sacu.sacu-ri.com