数据源拆分到新工作薄并使用指定表格模板

vivi_an84

想要用宏或其他简单的操作达成附件里描述的结果,请各位大神帮忙!感谢~

西瓜9527

Sub a()
'设置不显示警告对话框
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets("模板").Select
For i = 2 To Sheets("数据源").[A1048576].End(3).Row
    company = Sheets("数据源").Cells(i, 1).Value '公司
    Sheets("模板").[A2].Value = "公司名称：" & Sheets("数据源").Cells(i, 1).Value
    person = Sheets("数据源").Cells(i, 5).Value '跟进人
    Sheets("模板").[C2].Value = "跟进人：" & Sheets("数据源").Cells(i, 5).Value
    Sheets("模板").[B3].Value = Sheets("数据源").Cells(i, 4).Value
    Sheets("模板").[A4].Value = "联系人：" & Sheets("数据源").Cells(i, 2).Value & "  电话：" & Sheets("数据源").Cells(i, 3).Value
    ActiveSheet.Copy                                   '复制工作表到新工作簿
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & person & "-" & company & ".xlsx"  '保存工作簿，并命名
    ActiveWorkbook.Close

Next
Application.ScreenUpdating = True
End Sub

vivi_an84

西瓜9527 发表于 2019-11-14 10:42
Sub a()
'设置不显示警告对话框
Application.DisplayAlerts = False

谢谢大神的回复,但模板表格里面在真实事件中是有很多个的,所以如果每个都要单独设定赋值就有点多,请问是否有其他办法优化一下,谢谢!

lvying

关键是你要把你的需求描写清楚，到底有哪些情况，你想怎么做，做成什么样

vivi_an84

lvying 发表于 2019-11-14 11:44
关键是你要把你的需求描写清楚，到底有哪些情况，你想怎么做，做成什么样

想要的结果如附件所示,但不论是数据源还是模板里面的项都是有很多记录的,模板里面原来的公式可以不要,但结果是按一家公司保存为一个工作薄,一个工作薄里面只有一个工作表,就是附件里面的"模板",楼上大神设置到每个单元格的值这样会要设置很多,所以希望可以优化一下!

西瓜9527

vivi_an84 发表于 2019-11-14 13:50
想要的结果如附件所示,但不论是数据源还是模板里面的项都是有很多记录的,模板里面原来的公式可以不要,但 ...

没理解你的意思，我那个程序最终的结果不就是你想要的吗，你用我那个附件有问题吗
楼上大神设置到每个单元格的值这样会要设置很多
你要设置很多什么呢？