首先，按键盘上的Alt+F11进入VBA代码编辑界面。

在工作簿中插入一个模块。代码如下：

Sub SaveAs()
 
    On Error Resume Next
 
    Dim FolderPath As String, FolderName As String, BN As String
 
    Dim ReturnValue As Integer
 
    BN = ActiveWorkbook.Name
 
    FolderPath = ThisWorkbook.Path
 
    FolderName = Mid(BN, 1, InStrRev(BN, ".", Len(BN)) - 1)
 
    Dim MyFile As Object
 
    Set MyFile = CreateObject("Scripting.FileSystemObject")
 
    If MyFile.folderexists(FolderPath & "\" & FolderName & "-Saved") Then
 
        ReturnValue = MsgBox("文件夹已存在，是否更新内容？", vbOKCancel, "Caution!")
 
        If ReturnValue = 2 Then Exit Sub
 
    Else
 
        MyFile.CreateFolder (FolderPath & "\" & FolderName & "-Saved")
 
        Set MyFile = Nothing
 
    End If
 
    Application.ScreenUpdating = False
 
    Application.DisplayAlerts = False
 
    Dim i As Integer
 
    For i = 1 To Sheets.Count
 
        Set Wk = Workbooks.Add
 
        Workbooks(BN).Sheets(i).Copy before:=Wk.Worksheets("Sheet1")
 
        Wk.SaveAs FolderPath & "\" & FolderName & "-Saved\" & ThisWorkbook.Sheets(i).Name
 
        Wk.Close
 
    Next i
 
    Application.DisplayAlerts = True
 
    Application.ScreenUpdating = True
 
End Sub

				

					
				
				

					
				
				

					
				
				

					
				
			

插入一个按钮并指定按钮至刚才插入的宏代码

点击刚才插入的按钮，运行完毕后可以看到在同目录下出现了一个名称为“拆分工作表-Saved”文件夹，打开文件夹可以看到被拆分出来的若干个工作表。