スタッフ個人個人に調査をしたりアンケートをとったりする時に、個人毎にブックを作って配布することがあります。
1人分ずつブックを手作業で作っていくのは大変なので、VBAを利用してテンプレート用のブックと名簿のブックを使ってスタッフ全員分のブック(Excelファイル)を作ってみます。
< スポンサーリンク >
VBAでスタッフ全員分のブックを作る
今回は、Microsoft Office 活用総合サイトの無料テンプレート用の有給休暇管理表を使います。
ファイル名:有給休暇管理表.xlsm
名簿も準備しておきます。このブックにVBAを記述します。
ファイル名:名簿.xlsm
同じフォルダに入れておきます。
名簿.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を実行すると、下図のように同じフォルダ内に個人毎のブックが出来ます。
こんな記事も書いています