生成108个合同模板,你手工操作1小时,我点下按钮秒搞定,真爽!

与 30万粉丝一起学Excel

VIP学员的问题，要根据公司名称批量生成工作表，再将模板的内容复制到每一个分表，单元格A2写上每个公司的名称，实际有108家公司，为了方便演示只模拟几个。

模板

名称

学员提到需要生成的合同有108家，传统方法插入工作表，复制粘贴修改名称，这样太慢了，希望能够批量生成。

既然是批量，那当然要借助VBA代码了，先来按运行效果。点下批量生成的按钮，瞬间就全部生成好了。

VBA跟公式不一样，很难解释每个代码的含义，不过对于普通人而言，懂得操作代码还有运行就可以。

点开发工具，VB，插入模块，将VBA下面的代码复制粘贴进去。

Sub 批量生成()Dim i, x As Integer'删除无关的工作表Application.DisplayAlerts = FalseFor x = Sheets.Count To 3 Step -1    Sheets(x).DeleteNextApplication.DisplayAlerts = True'批量生成模板For i = 2 To Sheets("名称").Cells(Rows.Count, 1).End(xlUp).Row    Sheets("模板").Select    Sheets("模板").Copy After:=Sheets(Sheets.Count)    Sheets(Sheets.Count).Name = Sheets("名称").Range("A" & i)    Sheets(Sheets.Count).Range("a2") = "甲方：" & Sheets("名称").Range("A" & i)    NextEnd Sub

插入一个按钮或者形状都行，来运行代码。

放在同一个工作簿是为了方便打印，如果是为了方便发送给客户，要批量生成108个工作簿才行。针对这种又该如何实现呢？

只需将代码换成下面这一段，再新建一个文件夹，将模板放进去，运行代码。

Sub 批量生成工作簿()    Dim i As Long, lastRow As Long    Dim newWb As Workbook    Dim savePath As String, srcName As String    savePath = ThisWorkbook.Path    If savePath = "" Then        MsgBox "请先把本工作簿保存到目标文件夹，再运行！", vbExclamation        Exit Sub    End If    savePath = savePath & "\"    Application.ScreenUpdating = False    Application.DisplayAlerts = False    lastRow = Sheets("名称").Cells(Rows.Count, 1).End(xlUp).Row    For i = 2 To lastRow        srcName = Sheets("名称").Range("A" & i).Value   ' 先取值，躲开活动簿切换坑        If srcName <> "" Then            Sheets("模板").Copy   ' 复制到新工作簿并激活            Set newWb = ActiveWorkbook            newWb.Sheets(1).Range("A2").Value = "甲方：" & srcName            newWb.Sheets(1).Name = "模板"            newWb.SaveAs savePath & srcName & ".xlsx"            newWb.Close SaveChanges:=False        End If    Next i    Application.DisplayAlerts = True    Application.ScreenUpdating = True    MsgBox "批量生成工作簿完成！共生成 " & lastRow - 1 & " 个文件。", vbInformationEnd Sub