全社員が載ってる名簿からいらない行を削除して必要な部署だけの名簿にするマクロ

こういう全社員が載ってる名簿から、いらない行を削除して

こんな感じに必要な部署の社員だけのリストを作るマクロ

コード

Sub 必要な部署だけの名簿にする()
    Dim ws As Worksheet
    Dim filterColumn As Range
    Dim filterValue As String
    Dim lastRow As Long
    Dim i As Long
    Dim response As VbMsgBoxResult
    
    ' バックアップを取っているか確認
    response = MsgBox("バックアップを取りましたか？", vbYesNo + vbQuestion, "バックアップの確認")
    
    ' バックアップを取っていない場合は終了
    If response = vbNo Then
        MsgBox "バックアップが取られていないため、作業を終了します。", vbExclamation, "作業終了"
        Exit Sub
    End If
    
    ' 大元のワークシートを指定
    Set ws = ActiveSheet
    
    ' フィルターの条件を指定（指定の文字列以外を削除）
    filterValue = InputBox("部署を入力してください")
    
    ' フィルターをかける列を指定
    Set filterColumn = ws.Range("A:A") ' A列を対象とする場合
    
    ' フィルターをクリア
    ws.AutoFilterMode = False
    
    ' 最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, filterColumn.Column).End(xlUp).Row
    
    ' オートフィルターモードを有効にしてフィルターを設定
    filterColumn.AutoFilter Field:=1, Criteria1:="<>" & filterValue
    
    ' フィルターされた行を削除
    For i = lastRow To 2 Step -1  'タイトルを入れている場合は2を消したい最初の行に変更
        If Not ws.Cells(i, filterColumn.Column).EntireRow.Hidden Then
            ws.Rows(i).Delete
        End If
    Next i
    
    ' オートフィルターモードをクリア
    ws.AutoFilterMode = False
    
    MsgBox filterValue & "だけのリストにしました"
    
End Sub