Private Sub SaveSheet(sht As Worksheet, fpath, Optional FileFormat As XlFileFormat = xlOpenXMLWorkbook)
    '把单表另存为指定路径文件,默认为xlsx格式
    sht.Copy
    ActiveWorkbook.SaveAs FileName:=fpath, FileFormat:=FileFormat, CreateBackup:=False
    ActiveWorkbook.Close
End Sub

Sub 多表拆分为文件(wbk As Workbook)
    Dim sht As Worksheet
    Dim path
    Application.ScreenUpdating = False
    path = MkDir2
    For Each sht In wbk.Worksheets
        SaveSheet sht, path & "\" & 文件名处理(sht.Name) & ".xlsx"
    Next
    Application.ScreenUpdating = True
End Sub

Private Function MkDir2(Optional path = "")
    'path为空的时候 直接返回日期时间命名的文件夹
    'path不为空的时候 按指定path创建新文件夹
    If path = "" Then
        path = ThisWorkbook.path & "\" & Format(Now, "yyMMdd_HHmmss")
    End If
    If Dir(path, vbDirectory) = "" Then
        MkDir path    '建立文件夹
    End If
    MkDir2 = path
End Function

Private Function 文件名处理(s)    '文件名非法字符错误的处理
    Dim ss
    ss = "\/:*?""<>|"
    For i = 1 To Len(ss)
        s = Replace(s, Mid(ss, i, 1), "_")
    Next
    文件名处理 = Left(s, 50)
End Function

Sub test()
    多表拆分为文件 Workbooks("XXXX.xlsx")
    MsgBox "拆分完毕!"
End Sub