Sub 宏1()
 Application.ScreenUpdating = False   '屏幕更新关闭
 Application.DisplayAlerts = False    '显示和预警提示关闭
 Dim folder As String   'String字符串
 folder = ThisWorkbook.Path & "\ 班级 "
 If Len(Dir(folder, vbDirectory)) = 0 Then MkDir folder   'vbDirectory文件夹   MkDir创建目录或文件夹
 Dim sht As Worksheet
 For Each sht In Worksheets
 sht.Copy
 ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & sht.Name & ".xls"   '另存在这个路径  名字是工作表名字.xls
 ActiveWorkbook.Close
 Next
 Application.ScreenUpdating = True
 Application.DisplayAlerts = True
End Sub

Export Worksheet
 
Option Explicit

Sub exportSheet()
    
    Const FolderPath As String = "C:\Test\"
    Const FileName As String = "ART.xlsx"
    Const SheetName As String = "Master List"
    
    On Error Resume Next
    Workbooks(FileName).Close
    On Error GoTo 0
    
    With ThisWorkbook
        Application.ScreenUpdating = False
        .Sheets(SheetName).Copy
        With ActiveWorkbook
            Application.DisplayAlerts = False
            .SaveAs FolderPath & FileName, xlOpenXMLWorkbook ' 51 (.xlsx)
            Application.DisplayAlerts = True
            .Close False
        End With
        ' Open Folder Path in Windows File Explorer.
        '.FollowHyperlink FolderPath
        '.Close
        Application.ScreenUpdating = True
    End With
    
End Sub

保存指定工作表为工作簿文件
 
1、指定的单一工作表
 
如果需要将工作簿中的工作表单独保存为一个工作簿文件，可以使用 Worksheet 对象的 Copy 方法，将指定的工作表复制到一个新建的工作簿。
 
Sub test()
    On Error GoTo line
    ActiveSheet.Copy  '复制工作表为工作簿
    ActiveWorkbook.Close savechanges:=True, Filename:="d:\123.xlsx" '保存当前工作簿即可
    Exit Sub
line:
    ActiveWorkbook.Close False
End Sub
 
2、所有工作表保存为工作簿
 
'方法一：
Sub test1()
    Application.ScreenUpdating = False '屏幕不更新
    Dim i As Integer
    Dim j As Integer
    Dim str As String
    j = Worksheets.Count
    For i = j To 1 Step -1
        Worksheets(i).Copy
    	str = ActiveWorkbook.Sheets(1).Name   '将工作簿名称改为工作表名称
        ActiveWorkbook.SaveAs Filename:="D:\data\" & str & ".xlsx"
        ActiveWorkbook.Close savechanges:=True
    Next
	Application.ScreenUpdating = True
End Sub

'方法二:
Sub test()
Dim sht As Worksheet
Application.ScreenUpdating = False
For Each sht In Sheets
    sht.Copy
    ActiveWorkbook.SaveAs Filename:="d:\data\" & sht.Name & ".xlsx"
    ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
End Sub

今天，做会计的朋友问我一个问题，怎么讲Excel的工作表拆分成单独的文件，并给我发了一个链接。
 
 

  https://jingyan.baidu.com/article/75ab0bcb0ecc67d6874db27e.html 
 

 
 
 

 说这个在他那执行不了，他还以为是office是非正版，专门买了个正版的。
 

 
 
 

 随便试了下，发现能执行，让他截图，发现是他的工作表都是 用日期命名的，比如2016.1，然后拆分的文件就直接把 .1当成后缀名了。
 

 
 
 

 修改下，强制将保存的文件以xls结尾，让他拿去执行了。我还真是第一次知道excel 还能用 代码来执行批量操作，又学到了。
 

 
 
 

 
Private Sub 分拆工作表()
       Dim sht As Worksheet
       Dim MyBook As Workbook
       Set MyBook = ActiveWorkbook
       For Each sht In MyBook.Sheets
           sht.Copy
           ActiveWorkbook.SaveAs Filename:=MyBook.Path & "\" & sht.Name & ".xls", FileFormat:=xlNormal     '将工作簿另存为EXCEL默认格式
           ActiveWorkbook.Close
       Next
       MsgBox "文件已经被分拆完毕!"
   End Sub