< スポンサーリンク >

VBAで名簿から個人毎のブックを作る

個人に調査をしたりアンケートをとったりする時に、個人毎にブックを作って配布することがあります。

1人分ずつブックを手作業で作っていくのは大変なので、VBAを利用してテンプレート用のブックと名簿のブックを使ってやってみます。

 

今回は、Microsoft Office 活用総合サイトの無料テンプレートの用の有給休暇管理表を使います。
ファイル名:有給休暇管理表.xlsm

kojin
kojin

 

名簿も準備しておきます。このブックにVBAを記述します。
ファイル名:名簿.xlsm

kojin

 

同じフォルダに入れておきます。

kojin

 

名簿.xlsmの標準モジュールに下記のように記述します。

Sub BookAddNewName()
    ' 変数の宣言
    Dim meiboWB As Workbook    ' 名簿ブック用
    Dim meiboWS As Worksheet    ' 名簿シート用
    Dim DirName As String    ' フォルダの名前用
    Dim kyuukaWB As Workbook    ' 有給休暇管理表ブック用
    Dim kyuukaWS As Worksheet    ' 有給休暇管理表シート用
    Dim LastRow As Integer    ' 名簿の最終行用
    Dim i As Integer    ' 繰り返し用
    Dim dataNO As Integer    ' NO用
    Dim dataSHOZOKU As String    ' 所属用
    Dim dataSIMEI As String    ' 氏名用

    ' 名簿のブックとシートを変数にセット
    Set meiboWB = ThisWorkbook
    Set meiboWS = meiboWB.Worksheets("Sheet1")

    ' 名簿のブックのフォルダパス
    DirName = meiboWB.Path

    ' 有給休暇管理表のブックを開く
    Workbooks.Open Filename:=DirName & "\有給休暇管理表.xlsm"

    ' 有給休暇管理表のブックとシートを変数にセット
    Set kyuukaWB = Workbooks("有給休暇管理表.xlsm")
    Set kyuukaWS = kyuukaWB.Worksheets("2015年")

    ' 名簿の最終行を取得
    LastRow = meiboWS.Range("A1").End(xlDown).Row

    ' 名簿の2行目から最終行まで繰り返す
    For i = 2 To LastRow
        ' NO、所属、氏名を変数にセット
        dataNO = meiboWS.Cells(i, 1).Value
        dataSHOZOKU = meiboWS.Cells(i, 2).Value
        dataSIMEI = meiboWS.Cells(i, 3).Value
        ' NO、所属、氏名を有給休暇管理表のシートに入力
        kyuukaWS.Range("B6").Value = dataNO
        kyuukaWS.Range("C6").Value = dataSHOZOKU
        kyuukaWS.Range("E6").Value = dataSIMEI
        ' 有給休暇管理表を「NO-氏名」のファイル名で保存
        kyuukaWB.SaveAs Filename:=DirName & "\" & dataNO & "-" & dataSIMEI & ".xlsm"
    Next

    ' 有給休暇管理表のブックを閉じる
    kyuukaWB.Close

    ' 名簿のブックを閉じる
    meiboWB.Close
End Sub

 

有給休暇管理表.xlsmは閉じておき、名簿.xlsmのVBAを実行すると、下図のように同じフォルダ内に個人毎のブックが出来ます。

kojin

 

< スポンサーリンク >



サブコンテンツ

このページの先頭へ