【分身の術】VBAを使って名簿データからブック複製する方法

Sub 分身の術()

'➀変数を宣言する
Dim name, address, tel, email, room As String
Dim manage As Long
Dim day As Date

Dim lastrow
Dim ws, list

'➁最終行を取得する
lastrow = Cells(Rows.Count, 1).End(xlUp).Row

'➂For分で繰り返し処理を始める
For i = 2 To lastrow

'➃テンプレート用ファイル「健康観察票」を開く
Workbooks.Open Filename:=ThisWorkbook.Path & "\健康観察票.xlsx"

'➄「健康観察票」と「名簿」のブックを変数に格納する
Set ws = Worksheets("健康観察票")
Set list = Workbooks("名簿").Worksheets("名簿")

'➅データ用ファイル「名簿」にあるデータを変数に格納する
  manage = list.Cells(i, 1).Value　'管理番号
    room = list.Cells(i, 2).Value　'部屋番号
 address = list.Cells(i, 3).Value　'住所
     tel = list.Cells(i, 4).Value　'電話番号
   email = list.Cells(i, 5).Value　'E mail
    name = list.Cells(i, 6).Value　'氏名
     day = list.Cells(i, 7).Value　'療養開始日

'➆「健康観察票」にデータを代入する
        With ws
                .Range("D4") = manage
                .Range("G4") = room
                .Range("K4") = address
                .Range("R4") = tel
                .Range("V4") = email
                .Range("D5") = name
                .Range("I5") = day
        End With
                
        
                ws.Activate

'➇氏名を加えて、名前を付けて保存する                
                ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\健康観察票(" & name & ") .xls"
                
                ActiveWorkbook.Close
 
'➈Forに戻り最終行まで繰り返し処理する     
Next i
    

End Sub

'➀変数を宣言する
Dim name, address, tel, email, room As String　'氏名、住所、電話番号、メール、部屋番号
Dim manage As Long　'管理番号
Dim day As Date　'日時

Dim lastrow　'最終行
Dim ws, list　'ワークシート

'➁最終行を取得する
lastrow = Cells(Rows.Count, 1).End(xlUp).Row

➂For分で繰り返し処理を始める
For i = 2 To lastrow

'➃テンプレート用ファイル「健康観察票」を開く
Workbooks.Open Filename:=ThisWorkbook.Path & "\健康観察票.xlsx"

➄「健康観察票」と「名簿」のブックを変数に格納する
Set ws = Worksheets("健康観察票")
Set list = Workbooks("名簿").Worksheets("名簿")

'➅データ用ファイル「名簿」にあるデータを変数に格納する
  manage = list.Cells(i, 1).Value　'管理番号
    room = list.Cells(i, 2).Value　'部屋番号
 address = list.Cells(i, 3).Value　'住所
     tel = list.Cells(i, 4).Value　'電話番号
   email = list.Cells(i, 5).Value　'E mail
    name = list.Cells(i, 6).Value　'氏名
     day = list.Cells(i, 7).Value　'療養開始日

'➆「健康観察票」にデータを代入する
        With ws
                .Range("D4") = manage
                .Range("G4") = room
                .Range("K4") = address
                .Range("R4") = tel
                .Range("V4") = email
                .Range("D5") = name
                .Range("I5") = day
        End With

'➇氏名を加えて、名前を付けて保存する                
                ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\健康観察票(" & name & ") .xls"