「Excelの不要なシート、一括削除！」 – 指定範囲にリストアップしたワークシート・グラフシートをまとめて削除するVBAマクロ公開！

Excelでの不要なシートの削除作業を効率化！
このマクロでできること
マクロのVBAコード
マクロ実行時の手順
注意点
最後に

Excelでの不要なシートの削除作業を効率化！

Excelのプロジェクトでシートの整理が必要になった時、一つひとつ手動で削除するのは非常に面倒ですよね。今回は、指定した範囲にリストアップしたワークシートやグラフシートを一括で削除するVBAマクロをご紹介します！

このマクロでできること

指定した範囲に記載されたワークシート・グラフシート名に基づいて、該当するシートを一括削除
アクティブなシートは削除対象外となるので、安心して使用可能
ワイルドカードを利用したあいまい検索にも対応

マクロのVBAコード

以下のコードをVBE(Altキー+F11キーで起動)の標準モジュールへ貼り付けてください(挿入→標準モジュール)。

Sub DeleteSheetsBasedOnSelection()

    Dim selectedRange As Range
    Dim originalSelection As Range
    Dim sht As Object
    Dim cell As Range
    Dim matchedSheets As Collection
    Dim matchedSheet As Variant
    Dim deleteConfirmMsg As String
    Dim response As VbMsgBoxResult

    ' もともと選択していたセル・範囲を記憶
    Set originalSelection = Selection

    ' インプットボックスで範囲を指定
    On Error Resume Next
    Set selectedRange = Application.InputBox("削除したいワークシート名が入力されているセル範囲を選択してください", Default:=originalSelection.Address, Type:=8)
    On Error GoTo 0

    ' キャンセルした場合は終了
    If selectedRange Is Nothing Then Exit Sub

    ' 一致するシートを格納するためのコレクションを初期化
    Set matchedSheets = New Collection

    ' 一致するシート名を見つけてコレクションに追加
    For Each cell In selectedRange.Cells
        For Each sht In ThisWorkbook.Sheets
            ' アクティブシートはスキップ
            If sht.Name = ActiveSheet.Name Then GoTo NextIteration

            ' ワイルドカードを利用して比較
            If sht.Name Like cell.Value Then
                On Error Resume Next
                matchedSheets.Add sht.Name, CStr(sht.Name)
                On Error GoTo 0
            End If
NextIteration:
        Next sht
    Next cell

    ' 削除対象のシートが無い場合は終了
    If matchedSheets.Count = 0 Then
        MsgBox "削除対象のワークシートがありません。"
        Exit Sub
    End If

    ' 削除確認メッセージを作成
    deleteConfirmMsg = "以下のワークシートをすべて削除しますか？元に戻すことはできません。" & vbCrLf & vbCrLf
    For Each matchedSheet In matchedSheets
        deleteConfirmMsg = deleteConfirmMsg & matchedSheet & vbCrLf
    Next matchedSheet

    ' 確認メッセージを表示
    response = MsgBox(deleteConfirmMsg, vbOKCancel + vbExclamation, "ワークシート削除確認")

    ' OKが押された場合はシートを削除
    If response = vbOK Then
        Application.DisplayAlerts = False
        For Each matchedSheet In matchedSheets
            ThisWorkbook.Sheets(matchedSheet).Delete
        Next matchedSheet
        Application.DisplayAlerts = True
    End If

    originalSelection.Select

End Sub