VBA 指定シート以外のシート削除

'指定シート以外を削除する
Sub DeleteSheetsExcept()
    Const WS_DEF As String = "DEF"
    Const WS_MAIN As String = "main"
    Dim ws As Worksheet
    Dim sheetName As String
    Dim delSheets As Collection
    Dim i As Long
    
    ' 削除候補を収集
    Set delSheets = New Collection
    For Each ws In ThisWorkbook.Sheets
        sheetName = ws.Name
        If sheetName <> WS_MAIN And sheetName <> WS_DEF Then
            delSheets.Add ws
        End If
    Next ws
    
    ' 削除対象なし
    If delSheets.Count = 0 Then
        MsgBox "削除対象のシートはありません。", vbInformation
        Exit Sub
    End If
    
    ' 確認メッセージ
    If MsgBox("「main」「DEF」以外の " & delSheets.Count & " シートを削除しますか？", vbYesNo + vbQuestion) = vbNo Then
        Exit Sub
    End If
    
    ' 複数シート削除（警告無効）
    Application.DisplayAlerts = False
    For i = delSheets.Count To 1 Step -1
        delSheets(i).Delete
    Next i
    Application.DisplayAlerts = True
    
    MsgBox "「main」「DEF」以外のシートを削除しました。", vbInformation
End Sub

コメント