代码如下:
Sub Createwks() Dim i&, p$, r Application.ScreenUpdating = False '取消屏幕刷新 Application.DisplayAlerts = False '取消警告提示,当有重名工作簿时直接覆盖 p = ThisWorkbook.Path & "\" '以当前工作簿所在的路径保存新建工作簿 r = [a1].CurrentRegion '数据装入数组r For i = 2 To UBound(r) '标题不要,因此从第2个元素开始遍历数组r With Workbooks.Add '新建工作簿 .SaveAs p & r(i, 1), xlWorkbookDefault '保存工作簿 .Close True '关闭工作簿 End With Next Application.ScreenUpdating = True Application.DisplayAlerts = TrueEnd Sub
小贴士:
1、该代码创建后的工作簿保存于代码所在工作簿同一路径下。
2、当A列工作簿名称存在特殊字符(不符合文件命名名称规则),会出现运行时错误提示框。特别需要提醒的是,某些日期格式并不符合文件命名规则,例如2015/8/8,但2015-8-8通常是允许的。
3,当有重名工作簿时,会直接覆盖保存。
小思考: 如何按指定模版批量创建Excel工作簿?
假设以代码所在工作簿的sheets(1)表格为模版,批量创建工作簿,并以sheets(2)的A列名称来命名,保存在当前文件夹下,您会如何写代码呢?
点击下面的原文链接可以下载练手文件哈~
Run the boys~