任意の名前で複数のシートを一括で追加する方法 - コピペでVBA(Excel)

こちらの記事はエクセルVBAをあまり知らない方でも利用できる「コピペでVBA(Excel)」としてもご活用できます。詳しくは以下の記事をご確認ください。

このマクロの解説

シート名を入力したセルを選択（複数可）した状態でマクロを実行すると、セルの値をシート名にしたシートが一括で追加できます。ただし、シート名に使用できない文字や空白、既に同じ名前が使用されている場合はエラーが発生します。

このマクロの解説（イメージ）

シート名に使用したい値が入力されたセルを選択

このように連続していないセルの選択でもOK

結果

このマクロのコード

Private Sub 名前を指定してシート追加()
    Dim s As Worksheet, r As Range, i As Long, a()
    Set s = ActiveSheet
    For Each r In Selection
        i = i + 1
        ReDim Preserve a(i)
        a(i) = r.Value
    Next r
    For i = 1 To UBound(a)
        Sheets.Add After:=ActiveSheet
        ActiveSheet.Name = a(i)
    Next i
    s.Select
End Sub

※コードをコピーする時は、右上のアイコンをクリックしてください

このマクロを使う理由

とにかく手間がかかるシート作成を改善するためです。 マクロを使わずに任意の名前のシートを追加するためには、

1. シートを追加（名前は自動付与）
2. 名前をつける

という2段階の作業になります。 これはシート1つずつ対応しないといけないので、複数のシートで行うのはたいへんです。

プラスワン：エラーを回避する方法

上記にも記載しましたが、シート名に使用できない文字や空白、既に同じ名前が使用されている場合はエラーが発生します。どのシートが問題なのかを確認するのが手間である場合や、そもそも重複をしないように追加したいので同じ名前があったら無視して処理をしてほしい、というようなこともあるかと思います。 そこでエラーを無視するコードを用意しました。 注意してほしい点としては、作成できていないシートがある可能性です。エラーを無視するので、エラーがあっても気づけません。たとえば、シート名の指定に「12/31の日報」という文言があった場合はエラーになり（シート名にスラッシュは使用不可）シートは作成されません。

Private Sub 名前を指定してシート追加()
    Dim s As Worksheet, r As Range, i As Long, a()
    Set s = ActiveSheet
    For Each r In Selection
        i = i + 1
        ReDim Preserve a(i)
        a(i) = r.Value
    Next r
    For i = 1 To UBound(a)
        On Error Resume Next
        Sheets.Add After:=ActiveSheet
        ActiveSheet.Name = a(i)
        If Err.Number <> 0 Then
            Application.DisplayAlerts = False
            ActiveSheet.Delete
            Application.DisplayAlerts = True
            Sheets(ActiveSheet.Index - 1).Select
        End If
    Next i
    s.Select
End Sub

※コードをコピーする時は、右上のアイコンをクリックしてください