求大神解答，如何引用数据源表中数据批量生成多个工作簿

haoilu

附件中2个文件：数据源  和  目标文件

利用数据源中的数据，批量生成多个工作簿。
每一行是一个工作簿，新的工作簿中有2个表引用了每一行中的部分数据。
下图是数据源：

下图是目标文件：

目标文件中"封皮"和"表三甲"标记颜色的部分引用了数据源中对应颜色的数据。
若数据源中有几十行的内容，如何实现批量生成多个目标文件呢？请大神帮忙解答

haoilu

新生成的工作簿，不能有链接~~辛苦大神

gwjkkkkk

Option Explicit
Sub test()
    Dim ar, br, i&, j&, strSaveName$, strFileName$, strPath$
   
    strPath = ThisWorkbook.Path & "\"
    strFileName = strPath & "目标文件.xlsx"
    If Dir(strFileName) = "" Then MsgBox "目标文件不存在，请检查！", vbExclamation: Exit Sub
   
    DoApp False
    ar = [A1].CurrentRegion
    br = [{5,2;5,6;11,6;8,1;11,1;22,3;14,2;17,2;8,6}]
    For i = 2 To UBound(ar)
        strSaveName = strPath & ar(i, 2)
        With Workbooks.Open(strFileName)
             With .Sheets(1)
                 For j = 1 To UBound(br)
                     .Cells(br(j, 1), br(j, 2)).Value = ar(i, j + 1)
                 Next j
             End With
             With .Sheets(3)
                  For j = 11 To 17
                      .Cells(5, j - 9).Value = ar(i, j)
                  Next j
             End With
             .SaveAs strSaveName
             .Close
        End With
    Next
   
    DoApp
    Beep
End Sub

gwjkkkkk

请参考附件。。。

haoilu

gwjkkkkk 发表于 2023-5-23 19:27
请参考附件。。。

感谢大神出手相助，文件命名是以区域参考，能否修改成别的？还请指点一二

gwjkkkkk

strSaveName = strPath & ar(i, 2) '这里你可以自己改一下。。。