教えてください

投稿者 : mitsu     投稿日時 : 2022/08/08(Mon) 17:11:02     OS : Windows 10     EXCEL : Excel 2013

---

sheet1に印刷対象者の一覧、
sheet2に案内状のフォーマットがあり、
sheet1の対象者の情報をsheet2の対象セルに転記、対象者別にexcelファイルで保存する方法を
教えていただけないでしょうか。

具体的には、Sheet1の
D列の情報→Sheet2のA1
E列の情報→Sheet2のA3
F列の情報→sheet2のF10とE37
I列の情報→Sheet2のA5とC33
J列の情報→Sheet2のC34
K列の情報→Sheet2のE34
L列の情報→Sheet2のE35
M列の情報→Sheet2のC36
N列の情報→Sheet2のC38
に転記したいのですが。

どのようにしたら可能かお教え頂けないでしょうか。
よろしくお願いいたします。

投稿者 : さんこう     投稿日時 : 2022/08/08(Mon) 17:37:10

---

参考になれば。

https://www.google.com/search?q=VBA+%E4%B8%80%E8%A6%A7%E8%A1%A8%E3%81%8B%E3%82%89%E3%83%95%E3%82%A9%E3%83%BC%E3%83%9E%E3%83%83%E3%83%88%E3%81%B8%E8%BB%A2%E8%A8%98

投稿者 : てらてら     投稿日時 : 2022/08/09(Tue) 19:49:49

---

こんにちは。
適当に改造してください。

Sub macro()
    'シート名を保持
    Dim ws1 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Dim ws2 As Worksheet
    Set ws2 = Worksheets("Sheet2")

    'ループの準備
    Dim i As Long
    Dim lastRow As Long
    lastRow = ws1.Cells(Rows.Count, "D").End(xlUp).Row  'Sheet1のD列で最終行を得る
        
    For i = 1 To lastRow
        '転記
        ws2.Range("A1") = ws1.Cells(i, "D")
        ws2.Range("A3") = ws1.Cells(i, "E")
        ws2.Range("F10") = ws1.Cells(i, "F")
        ws2.Range("E37") = ws1.Cells(i, "F")
        ',,,こんな感じで続ける,,,
        
        ws2.Copy
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "Test" & i & ".xlsx"
        ActiveWorkbook.Close
    Next i
    
End Sub

投稿者 : rrt     投稿日時 : 2022/08/10(Wed) 07:41:22

---

[[20220809131125]]　『excel一覧から案内状作成法について』（みつ）
https://www.excel.studio-kazu.jp/kw/20220809131125.html?t=190659

投稿者 : mitsu     投稿日時 : 2022/08/10(Wed) 13:06:14

---

こんにちは。
無事やりたかったことができました。
大変助かりました。ありがとうございました。


■[返信 2] てらてらさん（2022-08-09 19:49:49）の記事
＞ こんにちは。
＞ 適当に改造してください。
＞
＞ Sub macro()
＞ 'シート名を保持
＞ Dim ws1 As Worksheet
＞ Set ws1 = Worksheets("Sheet1")
＞ Dim ws2 As Worksheet
＞ Set ws2 = Worksheets("Sheet2")
＞
＞ 'ループの準備
＞ Dim i As Long
＞ Dim lastRow As Long
＞ lastRow = ws1.Cells(Rows.Count, "D").End(xlUp).Row 'Sheet1のD列で最終行を得る
＞
＞ For i = 1 To lastRow
＞ '転記
＞ ws2.Range("A1") = ws1.Cells(i, "D")
＞ ws2.Range("A3") = ws1.Cells(i, "E")
＞ ws2.Range("F10") = ws1.Cells(i, "F")
＞ ws2.Range("E37") = ws1.Cells(i, "F")
＞ ',,,こんな感じで続ける,,,
＞
＞ ws2.Copy
＞ ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "Test" & i & ".xlsx"
＞ ActiveWorkbook.Close
＞ Next i
＞
＞ End Sub
＞