按指定名称批量创建工作簿

迷失缠绵情愫中

按指定名称批量创建Excel工作簿。
如下图所示，A列是需要创建的Excel工作簿名称，有十几个表。

1. Sub Createwks()
   
2.     Dim i&, p$, r
   
3.     Application.ScreenUpdating = False
   
4.     '取消屏幕刷新
   
5.     Application.DisplayAlerts = False
   
6.     '取消警告提示，当有重名工作簿时直接覆盖
   
7.     p = ThisWorkbook.Path & ""
   
8.     '以当前工作簿所在的路径保存新建工作簿
   
9.     r = [a1].CurrentRegion
   
10.     '数据装入数组r
    
11.     For i = 2 To UBound(r)
    
12.     '标题不要，因此从第2个元素开始遍历数组r
    
13.         With Workbooks.Add '新建工作簿
    
14.             .SaveAs p & r(i, 1), xlWorkbookDefault
    
15.             '保存工作簿
    
16.             .Close True
    
17.             '关闭工作簿
    
18.         End With
    
19.     Next
    
20.     Application.ScreenUpdating = True
    
21.     Application.DisplayAlerts = True
    
22. End Sub

复制代码

ps:
1、该代码创建后的工作簿保存于代码所在工作簿同一路径下。
2、当A列工作簿名称存在特殊字符（不符合文件命名名称规则），会出现运行时错误提示框。特别需要提醒的是，某些日期格式并不符合文件命名规则，例如2015/8/8，但2015-8-8通常是允许的。
3，当有重名工作簿时，会直接覆盖保存。