VBA代码按模板批量新建Excel工作簿&自动填充单元格信息（2.0）

<<<<接续投稿的1.0

1.代码①用于将模板复制到新建工作簿中，代码②用于将源文件（即新建工作簿所需名单所在的那个文件，也是粘贴代码的那个文件）。因此，完成“按模板批量与自动填充信息”这一操作需要准备三个文件。

（文件命名没有严格要求，在操作过程中统一即可，图片中仅作演示）

(1)——>准备好三个文件。Demo - Template和Demo - Value都是源文件，只是名字不同；Template文件为模板文件，各个单元格的文本格式（数字、文本、日期等）您可以设置好，为填充信息做准备。

(2)——>将代码①粘贴到Demo - Template工作簿中，运行，即可得到批量新建并且已经命名好的工作簿。

(3)——>再将代码②粘贴到Demo - Value工作簿中，运行，新建的工作簿中单元格信息即被填充好。

2.为什么不把两个功能合并？调试过了，一直报错，显示计算越界，进入死循环了，后续将做优化。（有会的好兄弟可以评论区交流一下，或者私信我一下，马上优化）

3. 代码如下：

①模板复制

Sub CopySpecificTemplateToNewWorkbook() '定义宏名
    
    '申明变量
    Dim srcWorkbook As Workbook
    Dim destWorkbook As Workbook
    Dim templateWorkbook As Workbook
    
    Dim srcSheet As Worksheet
    Dim destSheet As Worksheet
    
    Dim srcCell As Range
    Dim destCell As Range
 
    Dim templatePath As String
    
    '1————建立循环
    For Each cell In Range("B2:B5") '！！！！需要手动修改为所需文件名保存的单元格列表（此处假设保存在B2:B5单元格中）
    Filename = cell.Text '获取批量新建工作簿所需的文件名
    
    '2————新建工作簿
    Set srcWorkbook = ActiveWorkbook
    Set destWorkbook = Workbooks.Add ' 创建一个新的工作簿
    
    '3————复制模板格式到新建工作簿
    templatePath = "C:\Users\trainee.pxb\Desktop\VBA代码调试\template" '！！！！需要手动修改模板文件所在路径
    Set templateWorkbook = Workbooks.Open(templatePath) '打开模板文件
    templateWorkbook.Sheets(1).Copy Before:=destWorkbook.Sheets(1) '复制模板格式（此处假设模板格式保存在template文件的第一张工作表中）
    
    '4————删除新建工作簿自带的第一个空白工作表
    Application.DisplayAlerts = False ' 关闭自动弹出的提示信息
    destWorkbook.Sheets(2).Delete
    Application.DisplayAlerts = True ' 恢复自动弹出的提示信息
    
    '5————新建工作簿保存并关闭（如不进行此操作，将需手动另存为，较为麻烦）
    destWorkbook.SaveAs Filename:="C:\Users\trainee.pxb\Desktop\VBA代码调试\" & Filename & ".xlsx" ' ！！！！需要手动修改修改为想保存新建工作簿的路径
    Workbooks(Filename & ".xlsx").Close SaveChanges:=True
    
    Next '构成循环语句，不可缺失，否则会报错
    
End Sub

②单元格信息填充

Sub CopySpecificCellToNewWorkbook() '定义宏名
    
    '申明变量
    Dim srcWorkbook As Workbook
    Dim destWorkbook As Workbook
    
    Dim srcSheet As Worksheet
    Dim destSheet As Worksheet
    
    Dim srcCell As Range
    Dim destCell As Range
    
    Dim i As Integer
    
    Dim destPath As String
    
    i = 2 '对单元格行号赋初值！！！！请自行修改为您需要的第一个单元格行号
    
    '1————建立循环
    For Each cell In Range("B2:B5") '！！！！需要手动修改为所需文件名保存的单元格列表（此处假设保存在B2:B5单元格中）
    Filename = cell.Text '获取批量新建工作簿所需的文件名
    
    '2————打开新建工作簿
    Set srcWorkbook = ActiveWorkbook
    destPath = "C:\Users\trainee.pxb\Desktop\VBA代码调试\" & Filename & ".xlsx" '！！！！需要手动修改为新建工作簿所在路径
    Set destWorkbook = Workbooks.Open(destPath) '打开新建工作簿
    
    '3————单元格信息复制（请按需求自行修改对应单元格）
    Set srcCell = srcWorkbook.Sheets(1).Range("B" & i) ' 设置源单元格！！！！请修改为实际的工作表索引或名称以及单元格地址
    Set destCell = destWorkbook.Sheets(1).Range("B2")  ' 设置目标单元格！！！！请修改为实际的工作表索引或名称以及单元格地址
    destCell.Value = srcCell.Value ' 将源单元格的值复制到目标单元格
    
    Set srcCell = srcWorkbook.Sheets(1).Range("D" & i)
    Set destCell = destWorkbook.Sheets(1).Range("B3")
    destCell.Value = srcCell.Value
    
    Set srcCell = srcWorkbook.Sheets(1).Range("A" & i)
    Set destCell = destWorkbook.Sheets(1).Range("D2")
    destCell.Value = srcCell.Value
    
    Set srcCell = srcWorkbook.Sheets(1).Range("F" & i)
    Set destCell = destWorkbook.Sheets(1).Range("F2")
    destCell.Value = srcCell.Value
    
    Set srcCell = srcWorkbook.Sheets(1).Range("C" & i)
    Set destCell = destWorkbook.Sheets(1).Range("E3")
    destCell.Value = srcCell.Value
    
    '6————新建工作簿保存并关闭（如不进行此操作，将需手动另存为，较为麻烦）
    Workbooks(Filename & ".xlsx").Close SaveChanges:=True
    'Workbooks(templatePath).Close SaveChanges:=True 此行代码用于关闭template模板文件，暂未调试成功，故保留注释
    i = i + 1 '单元格行号自加1（您也可以限制i的值，添加退出逻辑）
    Next '构成循环语句，不可缺失，否则会报错
    
End Sub

Workbook——工作簿

Sheet——工作表

Cell——单元格