将汇总表或者其他文件内容按照模板要求填写并生成对应文件

liulang0808

将汇总表里的内容分到模板上，并根据要求保存为文件。
最近有人咨询这样的问题，所以整理在这里。
sheets(2)表为汇总表
sheets(1)为模板表。也可以是文件，如果要调取该文件，在打开状态下可以使用workbooks（“文件名”）
Sub s111()
    For j = 2 To Sheets(2).Cells(Rows.Count, 1).End(3).Row
        Sheets(1).Cells(2, 2) = Sheets(2).Cells(j, 1)
        Sheets(1).Cells(2, 4) = Sheets(2).Cells(j, 2)
        Sheets(1).Cells(3, 2) = Sheets(2).Cells(j, 3)
        Sheets(1).Cells(3, 4) = Sheets(2).Cells(j, 4)
        Sheets(1).Cells(4, 2) = Sheets(2).Cells(j, 5)
        strfile = ThisWorkbook.Path & "\" & Sheets(2).Cells(j, 1) & "_" & Sheets(2).Cells(j, 2) & ".xls"‘设置保存文件的名称
        ThisWorkbook.Sheets(1).Select
        ThisWorkbook.Sheets(1).Copy
        ActiveWorkbook.SaveAs Filename:= _
            strfile, FileFormat:=xlNormal _
            , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
            CreateBackup:=False
            
        ActiveWorkbook.Close False
    Next j
End Sub

其中也可以根据需要，将模板进行打印出来。

飞向新的天空

非常实用的功能，学习了！谢谢！

liulang0808

飞向新的天空 发表于 2013-12-17 09:01
非常实用的功能，学习了！谢谢！

有用就好，最近确实不少人问这样的问题，所以整理了下

kszcs

这个很实用

liulang0808

kszcs 发表于 2013-12-26 07:29
这个很实用

有一些实用的代码可以作为案例保存，方便以后直接使用的

kszcs

liulang0808 发表于 2013-12-26 07:30
有一些实用的代码可以作为案例保存，方便以后直接使用的

是呀，你们高手的东西很值得留存

liulang0808

kszcs 发表于 2013-12-26 09:15
是呀，你们高手的东西很值得留存

其实，你自己日常处理问题的代码也要注意保留，处理多了，就有规律可循了

ylf969

非常实用的功能

无雨谷

谢谢分享，收藏了

peter-chen

请教老师，前面这个你如果要改成由自己选择位置而不是固定位置，同时对同一个字段对应的值自动往选好后的位置下面一行或一列逐个添加呢？

另外：下面的VBA，如果遇到Sheets("数据").Cells(j, 4)有同样的值，能否把数据追加在后面而不是另外再起一个新名字的表呢？谢谢老师指点。
Sub 批量复制模板并添加数据()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

For j = 2 To Sheets("数据").Cells(Rows.Count, 1).End(3).Row
    Sheets("模板").Copy after:=Sheets("模板") '在表“模板”后新建一张跟“模板”表内容一致的表（after 可以根据需要修改为before）
    '以下赋值可以根据自己需要进行计算等复杂操作
    Sheets("模板 (2)").Cells(2, 1) = Sheets("数据").Cells(j, 1)
    Sheets("模板 (2)").Cells(2, 2) = Sheets("数据").Cells(j, 2)
    Sheets("模板 (2)").Cells(2, 3) = Sheets("数据").Cells(j, 3)
    Sheets("模板 (2)").Cells(2, 4) = Sheets("数据").Cells(j, 4)
    Sheets("模板 (2)").Name = Sheets("数据").Cells(j, 1)       '修改新建表的表名为对应“数据”表的对应行名称
Next j

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub