一瞬でExcelワークシートを一括作成！範囲指定だけのマクロを公開

一瞬でExcelワークシートを一括作成するマクロのご紹介
このマクロの主な機能
VBAコード
マクロ実行時の手順
注意点

一瞬でExcelワークシートを一括作成するマクロのご紹介

日々の業務でExcelを使用している方に、時短マクロをご紹介します！セル範囲を指定するだけで、その範囲の名前を持つワークシートを一括で作成することができるマクロです。これを利用すれば、複数のシート名を手動で一つ一つ作成する手間が大幅に省けます。

このマクロの主な機能

指定したセル範囲の値をワークシート名として新しいシートを一括作成。
シート名として使用できない文字や、既に存在するシート名、長すぎる名前などを事前にチェックし、エラーメッセージを表示。
実行後、もともとの選択範囲へ自動的に戻る。

VBAコード

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

Sub CreateWorksheetsFromRange()

    Dim targetRange As Range, originalSelection As Range
    Dim cell As Range, cellCheck As Range
    Dim ws As Worksheet
    Dim sheetName As String
    Dim sheetExists As Boolean
    Dim invalidChars As String
    Dim char As String
    Dim i As Integer

    ' 既定値を現在選択されている範囲に設定
    Set originalSelection = Selection
    On Error Resume Next
    Set targetRange = Application.InputBox("シート名としたい値が入力されている範囲を選択してください", Type:=8, Default:=Selection.Address)
    On Error GoTo 0
    
    ' キャンセルした場合の処理
    If targetRange Is Nothing Then
        originalSelection.Worksheet.Select
        Exit Sub
    End If

    invalidChars = "\/*[]:?"

    ' まず、全てのセルの値を検証する
    For Each cell In targetRange
        sheetName = Trim(cell.Value)
        
        ' 空白セルをスキップ
        If sheetName = "" Then
            GoTo NextCell
        End If

        sheetExists = False

        ' 使用できない文字をチェック
        For i = 1 To Len(invalidChars)
            char = Mid(invalidChars, i, 1)
            If InStr(sheetName, char) > 0 Then
                MsgBox "エラー: シート名'" & sheetName & "'に使用できない文字'" & char & "'が含まれています。", vbCritical
                originalSelection.Worksheet.Select
                Exit Sub
            End If
        Next i

        ' 文字数制限をチェック
        If Len(sheetName) > 31 Then
            MsgBox "エラー: シート名'" & sheetName & "'が31文字を超えています。", vbCritical
            originalSelection.Worksheet.Select
            Exit Sub
        End If

        ' 一意性をチェック(既存のシートとの比較)
        For Each ws In ThisWorkbook.Worksheets
            If LCase(ws.Name) = LCase(sheetName) Then
                sheetExists = True
                Exit For
            End If
        Next ws
        
        If sheetExists Then
            MsgBox "エラー: シート名'" & sheetName & "'は既に存在します。", vbCritical
            originalSelection.Worksheet.Select
            Exit Sub
        End If
        
        ' 一意性をチェック(選択範囲内のデータとの比較)
        For Each cellCheck In targetRange
            If cell.Address <> cellCheck.Address And LCase(Trim(cell.Value)) = LCase(Trim(cellCheck.Value)) And Trim(cellCheck.Value) <> "" Then
                MsgBox "エラー: シート名'" & sheetName & "'が選択範囲内で重複しています。", vbCritical
                originalSelection.Worksheet.Select
                Exit Sub
            End If
        Next cellCheck

NextCell:
    Next cell

    ' シート名の検証が成功したので、ワークシートを作成する
    For Each cell In targetRange
        sheetName = Trim(cell.Value)
        
        ' 空白セルをスキップ
        If sheetName = "" Then
            GoTo SkipCreation
        End If
        
        On Error GoTo ErrorHandler
        ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)).Name = sheetName
        On Error GoTo 0

SkipCreation:
    Next cell

    originalSelection.Worksheet.Select
    Exit Sub

ErrorHandler:
    MsgBox "エラー: シート'" & cell.Value & "'の作成中に予期しないエラーが発生しました。", vbCritical
    originalSelection.Worksheet.Select

End Sub

マクロ実行時の手順

マクロをExcelにインポートします(標準モジュールへ挿入)。
Excel内で、新しいワークシート名として使用したい名前を入力した範囲を選択します。
CreateWorksheetsFromRangeマクロを実行します(Altキー+F8キーでマクロリストが表示されます)。するとインプットボックスが表示されます。この時点で既に範囲が選択されていれば、その範囲が既定値として設定されています。
「OK」をクリックすると、マクロが指定した範囲の名前を元にワークシートを一括で作成します。