【VBA】セルの値からシートを追加するマクロ

VBAでシートを作成するマクロを作りたいと思い作ってみた。

以下にそのサンプルコードを示します。

CreateSheetsFromA1Values

Sub CreateSheetsFromA1Values()
    Dim ws As Worksheet
    Dim newSheet As Worksheet
    Dim cell As Range
    Dim lastRow As Long
    Dim sheetName As String

    ' 作業中のシートを設定
    Set ws = ThisWorkbook.Sheets("Sheet1") ' ここで"Sheet1"を対象シート名に変更してください

    ' A列の最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' A1から最終行までのセルをループ
    For Each cell In ws.Range("A1:A" & lastRow)
        sheetName = cell.Value

        ' シート名が空でないことを確認
        If Len(sheetName) > 0 Then
            ' シート名の重複をチェック
            On Error Resume Next
            Set newSheet = ThisWorkbook.Sheets(sheetName)
            On Error GoTo 0

            ' すでに同名のシートが存在しない場合に新規作成
            If newSheet Is Nothing Then
                ' 新しいシートを追加して名前を変更
                ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = sheetName
            End If

            ' 変数をリセット
            Set newSheet = Nothing
        End If
    Next cell
End Sub

説明:

1. 対象シートの設定: Set ws = ThisWorkbook.Sheets("Sheet1") で対象となるシートを指定します。ここで "Sheet1" を対象シート名に変更してください。
2. 最終行の取得: lastRow でA列の最終行を取得します。
3. ループ処理: For Each cell In ws.Range("A1:A" & lastRow) でA1から最終行までのセルをループします。
4. シート名のチェック: If Len(sheetName) > 0 でシート名が空でないことを確認します。
5. シート名の重複チェック: すでに同じ名前のシートが存在しないかを確認し、存在しない場合には新しいシートを作成してその名前にします。

まとめ

このマクロを実行することで、指定されたシートにA1から最終行までのセルの値を名前にした新しいシートが作成されます。シート名がすでに存在する場合はスキップされます。