VBAで一覧表の名前をもとにシートを自動作成するには、A列の名前をFor Eachでループしながら Sheets.Add と .Name で作成するだけです。重複チェック・禁止文字の除去・テンプレートのコピーも組み合わせると、実務で使えるコードになります。
この記事では、次の内容を順番に解説します。
- 一覧表からシートを自動作成する基本コード
- 既存シートをスキップする重複チェックの方法
- シート名に使えない文字を自動で除去する方法
- テンプレートシートをコピーして作成する方法
- 不要なシートをまとめて削除する方法
一覧表からシートを自動作成するには？
「NameList」シートのA列に名前が並んでいる前提で、その名前をシート名にしてシートを順番に作成します。
Sub CreateSheets()
Dim ws As Worksheet
Dim lastRow As Long
Dim nameCell As Range
Dim newWs As Worksheet
Dim sName As String
' 名前一覧のシートを指定
Set ws = ThisWorkbook.Sheets("NameList")
' A列の最終行を取得
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' A列2行目〜最終行をループ
For Each nameCell In ws.Range(ws.Cells(2, 1), ws.Cells(lastRow, 1))
sName = Trim(nameCell.Value)
' 空白はスキップ
If sName <> "" Then
' 末尾に追加してシートを作成
Set newWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
newWs.Name = sName
End If
Next nameCell
MsgBox "シートの作成が完了しました。"
End Subコードのポイント：
Trim(nameCell.Value)：セルの値の前後のスペースを除去してからシート名に使います。After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)：既存シートの一番後ろに追加します。- 名前順に作成したい場合は、ループの前に
nameRange.Sortで昇順に並べ替えてから処理します。
重複シートをスキップするには？
同じ名前のシートが既に存在する状態でマクロを実行すると、「シート名が重複しています」のエラーになります。On Error Resume Next でシートの存在を確認してからスキップする処理を加えます。
Sub CreateSheetsSkipDuplicate()
Dim ws As Worksheet
Dim lastRow As Long
Dim nameCell As Range
Dim newWs As Worksheet
Dim sName As String
Set ws = ThisWorkbook.Sheets("NameList")
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For Each nameCell In ws.Range(ws.Cells(2, 1), ws.Cells(lastRow, 1))
sName = Trim(nameCell.Value)
If sName <> "" Then
' 同名シートが存在するか確認
On Error Resume Next
Set newWs = ThisWorkbook.Sheets(sName)
On Error GoTo 0
If newWs Is Nothing Then
' 存在しない場合だけ作成
Set newWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
newWs.Name = sName
Else
Debug.Print sName & " は既に存在するためスキップしました。"
End If
' 次のループのために変数を初期化
Set newWs = Nothing
End If
Next nameCell
MsgBox "処理が完了しました。"
End Subシート名の禁止文字を除去するには？
Excelのシート名には使えない文字があります（\ / : * ? [ ] の7種類）。セルに入力されたデータにこれらが含まれているとエラーになるため、あらかじめ除去します。
' シート名の禁止文字を除去するFunction
Function CleanSheetName(sName As String) As String
Dim result As String
result = sName
result = Replace(result, "\", "")
result = Replace(result, "/", "")
result = Replace(result, ":", "")
result = Replace(result, "*", "")
result = Replace(result, "?", "")
result = Replace(result, "[", "")
result = Replace(result, "]", "")
' シート名は31文字以内
If Len(result) > 31 Then result = Left(result, 31)
CleanSheetName = result
End FunctionこのFunctionをシート作成コードに組み込みます。
For Each nameCell In ws.Range(ws.Cells(2, 1), ws.Cells(lastRow, 1))
sName = CleanSheetName(Trim(nameCell.Value)) ' 禁止文字を除去
If sName <> "" Then
On Error Resume Next
Set newWs = ThisWorkbook.Sheets(sName)
On Error GoTo 0
If newWs Is Nothing Then
Set newWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
newWs.Name = sName
End If
Set newWs = Nothing
End If
Next nameCellテンプレートをコピーしてシートを作成するには？
シートを新規作成するだけでなく、フォーマットが入った「テンプレート」シートをコピーして作成することもできます。請求書や報告書など、毎回同じ書式で作りたいときに便利です。
Sub CreateSheetsFromTemplate()
Dim ws As Worksheet
Dim templateWs As Worksheet
Dim lastRow As Long
Dim nameCell As Range
Dim newWs As Worksheet
Dim sName As String
Set ws = ThisWorkbook.Sheets("NameList")
Set templateWs = ThisWorkbook.Sheets("テンプレート") ' コピー元シート
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For Each nameCell In ws.Range(ws.Cells(2, 1), ws.Cells(lastRow, 1))
sName = CleanSheetName(Trim(nameCell.Value))
If sName <> "" Then
On Error Resume Next
Set newWs = ThisWorkbook.Sheets(sName)
On Error GoTo 0
If newWs Is Nothing Then
' テンプレートをコピーして末尾に追加
templateWs.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
' コピーしたシートに名前をつける
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = sName
End If
Set newWs = Nothing
End If
Next nameCell
MsgBox "テンプレートからシートを作成しました。"
End Sub注意：テンプレートシート自体が一番後ろにある場合、コピーがテンプレートの直後に挿入されます。テンプレートシートは先頭か固定の位置に置いておくと管理しやすくなります。
不要なシートをまとめて削除するには？
作成したシートをリセットして作り直したい場合など、特定のシートをまとめて削除するコードも覚えておくと便利です。
Sub DeleteCreatedSheets()
Dim ws As Worksheet
Dim listWs As Worksheet
Dim lastRow As Long
Dim nameCell As Range
Dim sName As String
Set listWs = ThisWorkbook.Sheets("NameList")
lastRow = listWs.Cells(listWs.Rows.Count, 1).End(xlUp).Row
' 削除確認ダイアログを非表示にする
Application.DisplayAlerts = False
For Each nameCell In listWs.Range(listWs.Cells(2, 1), listWs.Cells(lastRow, 1))
sName = CleanSheetName(Trim(nameCell.Value))
If sName <> "" Then
On Error Resume Next
Set ws = ThisWorkbook.Sheets(sName)
On Error GoTo 0
If Not ws Is Nothing Then
ws.Delete
Set ws = Nothing
End If
End If
Next nameCell
Application.DisplayAlerts = True ' 必ず元に戻す
MsgBox "シートの削除が完了しました。"
End Sub注意：削除したシートは元に戻せません。実行前にファイルのバックアップを取っておくか、削除前に確認メッセージを入れることをおすすめします。
まとめ
- 基本のシート作成：
Sheets.Add＋.NameでA列の名前をシート名にして作成。 - 重複チェック：
On Error Resume Nextでシートの存在を確認し、Is Nothingで判定。 - 禁止文字の除去：
\ / : * ? [ ]をReplaceで除去し、31文字以内に収める。 - テンプレートコピー：
templateWs.Copy After:=でフォーマット付きシートを量産できる。 - まとめて削除：
DisplayAlerts = Falseで確認ダイアログを抑制して削除。必ずTrueに戻す。
よくある質問
シートを名前順（昇順）に並べて作成したいのですがどうすればいいですか？
ループの前に一覧の名前範囲をSortで並べ替えておきます。ただし元の一覧の順番が変わってしまうため、並べ替えたくない場合は配列に取り込んでからソートする方法が安全です。
' ループ前に名前範囲を昇順で並べ替える
Dim nameRange As Range
Set nameRange = ws.Range(ws.Cells(2, 1), ws.Cells(lastRow, 1))
nameRange.Sort Key1:=nameRange, Order1:=xlAscending, Header:=xlNoシート名は最大何文字まで使えますか？
Excelのシート名は最大31文字までです。31文字を超えるとエラーになるため、CleanSheetName 関数の中で Left(result, 31) を使って自動的に切り詰めています。
作成したシートに自動でデータを入力できますか？
できます。シート作成後に newWs.Cells(1, 1).Value = "見出し" のように書けば、作成と同時にデータを入力できます。例えば「A1セルに名前を入れる」「B2セルに日付を入れる」といった処理をFor Eachの中に追加するだけです。
「NameList」以外のシート名にも対応できますか？
できます。Set ws = ThisWorkbook.Sheets("NameList") の "NameList" 部分を実際のシート名に変えるだけです。シート名を毎回変えるのが手間な場合は、InputBoxでシート名を入力させるか、決まったルール（例：常に1枚目のシート）にしておくと使いやすくなります。
作成したシートが増えすぎてしまいました。一括削除できますか？
この記事で紹介した「不要なシートをまとめて削除する」コードを使えば、一覧表に記載された名前のシートをまとめて削除できます。削除は元に戻せないため、実行前に必ずファイルを別名で保存してバックアップを取っておいてください。
動画で学びたい方へ
「記事を読んでも、実際に自分で書けるか不安…」という方には、動画で基礎からじっくり学べる講座がおすすめです。
VBAが初めての方を前提に、つまずきやすいポイントを先回りして解説しています。サンプル動画は無料でご覧いただけます。
