VBA代码实例---批量新建工作表模板升级版本

对上一篇博文进行补充：


VBA代码实例---批量新建工作表模板

¤升级内容¤

新建了工作表之后，把新建的工作表，一个工作表新建到工作簿中，并以工作表的名称命名工作簿。

¤新增知识点¤
通过剪切的方式，新建工作簿。

¤代码示例¤

Option Explicit

Sub 拆分到簿()

Dim i As Integer
Dim sh As Worksheet
Dim sName As String

Dim tm As Single
tm = Timer

Dim sYuan As String
sYuan = ActiveSheet.Name

'第一行为标题，所以从第二行开始，如果无标题应该i=1
For i = 2 To Worksheets(sYuan).Range("A1").CurrentRegion.Rows.Count

sName = Worksheets(sYuan).Range("A" & i).Value

'判断工作表是否存在，如果不存在就新建
On Error Resume Next
Set sh = Worksheets(sName)    '如果工作表不存在，报错并返回非零值给Err.Number

If Err.Number <> 0 Then
Set sh = Worksheets.Add(, Worksheets(Worksheets.Count))
sh.Name = sName
End If

Next i

Worksheets(sYuan).Select

'MsgBox "拆分完成，耗时：" & Format(Timer - tm, "0.00000") & "秒"

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wb As Workbook

For i = Worksheets.Count To 1 Step -1

sName = Worksheets(Worksheets.Count).Name
If sName = sYuan Then Exit For
Worksheets(i).Move
Set wb = ActiveWorkbook
wb.SaveAs ThisWorkbook.Path & "\Test\" & sName & ".xlsx"
wb.Close

Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True

'MsgBox "工作簿新建完成，耗时：" & Format(Timer - tm, "0.00000") & "秒"

End Sub

自此，就是一个完整的可以应用的代码，马上你会看到应用，半个馒头，坚持一下下。