Excel·VBA模板生成文件

不同于《python实现Excel邮件合并》，字符串内容替换生成文件，仅复制整行数据插入模板中生成工作表，单独保存为工作簿，但如果存在同名工作簿文件，则将工作表附加在该工作簿中

Sub 模板生成工作薄()
    Application.Visible = False  '后台运行，不显示界面
    Application.DisplayAlerts = False  '不显示警告信息
    Dim arr, i, k, v, dict As Object, d As Object, fso As Object
    Set dict = CreateObject("scripting.dictionary")
    Set d = CreateObject("scripting.dictionary")
    Set fso = CreateObject("Scripting.FileSystemObject")  '文件访问对象
    
    arr = [a1].CurrentRegion
    For i = 2 To UBound(arr)
        Set temp = Range(Cells(i, 1), Cells(i, UBound(arr, 2)))  '数据区域range
        If Not dict.Exists(arr(i, 2)) Then  '新键-值
            Set dict(arr(i, 2)) = temp
        Else  '已有键-值，更新
            Set dict(arr(i, 2)) = Union(dict(arr(i, 2)), temp)  'Union,range对象
        End If
        d(arr(i, 2)) = d(arr(i, 2)) + 1  '行数
    Next
    k = dict.keys
    v = dict.Items
    Set mb = Sheets("模板")
    save_path = ThisWorkbook.Path  '文件保存路径
    For i = 0 To dict.Count - 1:   '遍历字典，创建、写入wb
        mb.Copy After:=Sheets(Sheets.Count)  '复制模板工作表
        Set ws = Application.ActiveSheet
            ws.Name = "9月"
            ws.Rows(4).Resize(d(k(i))).Insert
            v(i).Copy ws.Range("a4")
            Range("x" & d(k(i)) + 4) = "=sum(x4:x" & d(k(i)) + 3 & ")"
            Range("z" & d(k(i)) + 4) = "=sum(z4:z" & d(k(i)) + 3 & ")"
            Range("aa" & d(k(i)) + 4) = "=sum(aa4:aa" & d(k(i)) + 3 & ")"
        save_file = save_path + "\" + k(i) + ".xlsx"  '保存文件路径全名
        If fso.FileExists(save_file) Then  '文件是否存在
            Set wb = Application.Workbooks.Open(save_file)  '打开文件
            ws.Copy After:=Sheets(wb.Sheets.Count)
        Else
            ws.Copy
            Set wb = ActiveWorkbook  '创建新工作簿
        End If
        ws.Delete
        wb.SaveAs Filename:=save_file
        wb.Close (False)
    Next
    Application.Visible = True
    Application.DisplayAlerts = True
            
End Sub

附件
《Excel·VBA模板生成文件（附件）》