【Excel VBA】一覧表から個票シートを一括作成

前回、【Excel】一覧表から個票のシート作成（VLOOKUP関数の利用）を紹介しました。今回はこの方法を活用し、VBAで一覧表から個票（単票）シートを一括作成するサンプルです。

内容：

アウトプットイメージ

次のように一覧表（リスト）から個票シートをVBAで一括作成する。

一覧表から個票シートを一括作成のアウトプットイメージ

この事例で、個票のレイアウトはシート「日報」、一括作成の設定は

シート「設定シート」にある。

具体的には、個票のレイアウトがあるシート「日報」の内容は次のとおり。

このシートは、前回の【Excel】一覧表から個票のシート作成（VLOOKUP関数の利用）と同様にVLOOKUP関数で一覧表の値を参照している。

個票のレイアウトがあるシート「日報」の内容

VBAサンプル

VBAでは、個票のレイアウトがあるシート「日報」で、レコードを表す固有の値（セルE1）の値を順次変更、シートのコピーを繰り返す。

これにより、一覧表から個票シートを一括作成する。

なお、設定シートは、VBAのメンテナンス業務を減らすため、シート名等の情報を次のように記載している。

設定シートの内容

コードの内容は次のとおり。

Option Explicit
    Dim 一覧シート As Worksheet
    Dim 個票様式 As Worksheet
    Dim 個票のレコードセル番地 As String
    Dim 開始行 As Long
    Dim 終了行 As Long
    Dim 行 As Long
    
Sub リストから個票に展開()
    Application.ScreenUpdating = False
    
    '初期設定　Sheets("設定シート")から値取得'
    With ThisWorkbook.Sheets("設定シート")
        Set 一覧シート = ThisWorkbook.Sheets(.Range("D3").Value)
        Set 個票様式 = ThisWorkbook.Sheets(.Range("D4").Value)
        個票のレコードセル番地 = .Range("D5").Value
    
        開始行 = .Range("D8").Value
        終了行 = .Range("D9").Value
    End With
    
    
    '終了行の確認、最大100件までとしている'
    If 終了行 - 開始行 > 100 Then
        終了行 = 開始行 + 100
        MsgBox "展開は、最大100件までです"
    End If

    '繰り返し'
    For 行 = 開始行 To 終了行
        個票様式.Range(個票のレコードセル番地).Value = 一覧シート.Cells(行, 1).Value
        個票様式.Copy after:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = 個票様式.Range(個票のレコードセル番地).Value
    Next 行

    Application.ScreenUpdating = True
End Sub

補足説明

・一括作成できる個票シートは最大100件にしています。管理可能であれば、上限を増やしても可です。

・開始行、終了行は、一覧表での”行”の情報です。

以上、VBAで一覧表から個票シートを一括作成するサンプルでした。