具体步骤：
按Alt+F11，打开VBA编辑器，在代码窗口中粘贴代码。
然后关闭VBA编辑器，返回Excel界面，然后按Alt+F8打开“宏”对话框，选择对应宏执行即可。
这四段代码大同小异，实现不同功能本质上只替换代码主体即可。
以下代码将每个所选的工作表单独保存为一个工作簿，存放位置与原工作簿路径相同，名称为“工作表名称.xlsx”。
1、保存全部表格，保留全部格式
Sub Save_All()Dim Sh As WorksheetDim wb As WorkbookDim cPath$cPath = ThisWorkbook.Path & "\"Application.ScreenUpdating = FalseApplication.EnableEvents = FalseApplication.DisplayAlerts = False' ----------------------------------------- 代码主体 -----------------------------------------For Each sht In ThisWorkbook.Worksheetssht.CopytheName = sht.Name & ".xlsx"ActiveWorkbook.SaveAs Filename:=cPath & "\" & theName, FileFormat:=xlNormalActiveWindow.CloseNext' ----------------------------------------- 代码主体 -----------------------------------------Application.EnableEvents = TrueApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueEnd Sub
2、保留特定表格，保留全部格式
Sub Save_Special_Sheet()Dim Sh As WorksheetDim wb As WorkbookDim cPath$cPath = ThisWorkbook.Path & "\"Application.ScreenUpdating = FalseApplication.EnableEvents = FalseApplication.DisplayAlerts = False' ----------------------------------------- 代码主体 -----------------------------------------Sheets("特定表格1").SelecttheName = "特定表格1.xlsx"ActiveWorkbook.SaveCopyAs cPath & "\" & theNameSheets("特定表格2").SelecttheName = "特定表格2.xlsx"ActiveWorkbook.SaveCopyAs cPath & "\" & theName' ........' ----------------------------------------- 代码主体 -----------------------------------------Application.EnableEvents = TrueApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueEnd Sub
3、保留选中的表格，保留格式
执行代码前，需要将光标移至EXCEL底栏工作区，选择单独保存为工作簿的工作表。如果要选择多个工作表，可按Ctrl键或Shift键进行选择。
Sub Save_Select_Sheet()Dim Sh As WorksheetDim wb As WorkbookDim cPath$cPath = ThisWorkbook.Path & "\"Application.ScreenUpdating = FalseApplication.EnableEvents = FalseApplication.DisplayAlerts = False' ----------------------------------------- 代码主体 -----------------------------------------For Each sht In ActiveWindow.SelectedSheetssht.CopytheName = sht.Name & ".xlsx"ActiveWorkbook.SaveAs Filename:=cPath & "\" & theName, FileFormat:=xlNormalActiveWindow.CloseNext' ----------------------------------------- 代码主体 -----------------------------------------Application.EnableEvents = TrueApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueEnd Sub
4、保存全部表格，不保留分表格式
Sub Save_All_Sheet_Value()Dim Sh As WorksheetDim wb As WorkbookDim cPath$, cFile$, nR1&, nR2&, Arr()cPath = ThisWorkbook.Path & "\"Application.ScreenUpdating = FalseApplication.EnableEvents = FalseApplication.DisplayAlerts = FalseFor Each Sh In WorksheetsnR1 = Sh.Range("a1048576").End(xlUp).RowIf nR1 > 1 ThenArr = Sh.Range("a2:z" & nR1).ValuecFile = Dir(cPath & Sh.Name & ".*")If cFile = "" ThenSet wb = Workbooks.AddWith wb.Sheets(1).Name = "汇总".SaveAs cPath & Sh.NameEnd WithElseWorkbooks.Open cPath & cFileSet wb = Workbooks(cFile)End IfWith wb.Sheets("汇总")nR2 = .Range("a1048576").End(xlUp).Row + 1.Range("a" & nR2).Resize(nR1 - 1, 26).Value = ArrIf .Range("a1").Value = "" ThenArr = Sh.Range("a1:z1").Value.Range("a1:z1").Value = ArrEnd IfEnd Withwb.Close (True)End IfNexApplication.EnableEvents = TrueApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueEnd Sub
5、创建操作工作表，在另存为工作簿时不对该表进行操作。
主要就是在原有代码上加功能，表识别以Me.name开头。以代码4为例。
新建“汇总”表并创建宏按钮：
打开VB编辑窗口，将代码复制到“Sheet6（汇总）”表中，如下
Sub Save_All_Sheet_Value()Dim Sh As WorksheetDim wb As WorkbookDim cPath$, cFile$, nR1&, nR2&, Arr()cPath = ThisWorkbook.Path & "\"Application.ScreenUpdating = FalseApplication.EnableEvents = FalseApplication.DisplayAlerts = False' ----------------------------------------- 代码主体 -----------------------------------------For Each Sh In WorksheetsIf Sh.Name <> Me.Name ThennR1 = Sh.Range("a1048576").End(xlUp).RowIf nR1 > 1 ThenArr = Sh.Range("a2:z" & nR1).ValuecFile = Dir(cPath & Sh.Name & ".*")If cFile = "" ThenSet wb = Workbooks.AddWith wb.Sheets(1).Name = "汇总".SaveAs cPath & Sh.NameEnd WithElseWorkbooks.Open cPath & cFileSet wb = Workbooks(cFile)End IfWith wb.Sheets("汇总")nR2 = .Range("a1048576").End(xlUp).Row + 1.Range("a" & nR2).Resize(nR1 - 1, 26).Value = ArrIf .Range("a1").Value = "" ThenArr = Sh.Range("a1:z1").Value.Range("a1:z1").Value = ArrEnd IfEnd Withwb.Close (True)End IfEnd IfNext' ----------------------------------------- 代码主体 -----------------------------------------Application.EnableEvents = TrueApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueEnd Sub
6、选择是否要清楚原表数据
生成新的子表后会弹出选项“已生成新子表。清除各工作表数据吗？”
Sub Ask_Delete()Dim Sh As WorksheetDim wb As WorkbookDim cPath$, cFile$, nR1&, nR2&, Arr()cPath = ThisWorkbook.Path & "\"Application.ScreenUpdating = FalseApplication.EnableEvents = FalseApplication.DisplayAlerts = False ' ----------------------------------------- 代码主体 -----------------------------------------For Each Sh In WorksheetsIf Sh.Name <> Me.Name ThennR1 = Sh.Range("a1048576").End(xlUp).RowIf nR1 > 1 ThenArr = Sh.Range("a2:z" & nR1).ValuecFile = Dir(cPath & Sh.Name & ".*")If cFile = "" ThenSet wb = Workbooks.AddWith wb.Sheets(1).Name = "汇总".SaveAs cPath & Sh.NameEnd WithElseWorkbooks.Open cPath & cFileSet wb = Workbooks(cFile)End IfWith wb.Sheets("汇总")nR2 = .Range("a1048576").End(xlUp).Row + 1.Range("a" & nR2).Resize(nR1 - 1, 26).Value = ArrIf .Range("a1").Value = "" ThenArr = Sh.Range("a1:z1").Value.Range("a1:z1").Value = ArrEnd IfEnd Withwb.Close (True)End IfEnd IfNext' ----------------------------------------- 代码主体 -----------------------------------------If MsgBox("已生成新子表。清除各工作表数据吗？", 36, "提示") = 6 ThenFor Each Sh In WorksheetsIf Sh.Name <> Me.Name Then Sh.Range("a2:z1048576").ClearContentsNextThisWorkbook.SaveEnd IfEnd Sub
参考：
1、Excel VBA-批量将多个sheet表另存为单独的工作薄文件，Crystal_Data
