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

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