关闭活动工作簿，如果工作簿有更改，提示是否保存：

    Sub CloseWorkbook()
    ActiveWorkbook.Close
    End Sub

    如果要避免出现提示，可添加“SaveChanges”参数，如直接保存并关闭工作簿：

    Sub ClostAndSaveWorkbook()
    ActiveWorkbook.Close Savechanges:=True
    End Sub

    将上述代码中的“True”改为“False”，则直接关闭工作簿而不保存。

    关闭所有打开的工作簿，并提示是否保存：

    Sub CloseAllWorkbooks()
    On Error Resume Next
    Workbooks.Close
    End Sub

    退出Excel，并提示对有更改的工作簿进行保存：

    Sub QuitExcel()
    Application.Quit
    End Sub

    保存活动工作簿并退出Excel：

    Sub SaveActiveWorkAndQuit()
    ActiveWorkbook.Save
    Application.Quit
    End Sub

    下面的代码在退出Excel时都不会提示是否保存工作簿。

    保存所有打开的工作簿并退出Excel：

    Sub SaveAllAndQuit()
    For Each wbk In Workbooks
    wbk.Save
    Next
    Application.Quit
    End Sub

    退出Excel，所有的改动都不保存：

    Sub QutiAndNoAlerts()
    Application.DisplayAlerts = False
    Application.Quit
    End Sub

一、代码

Sub test()
    Dim wb As Workbook, sht As Worksheet    '定义一个Workbook对象和一个Worksheet对象
    Set wb = Workbooks.Add                  '新建一个工作簿
    Set sht = wb.Worksheets(1)
    
    With sht
        .Name = "另存工资表"                '修改第一张工作表的标签名称
        .Range("A1:F1") = Array("序号", "姓名", "部门", "职位", "基本工资", "实际到账")     '设置表头
    End With
    
    wb.SaveAs ThisWorkbook.Path & "\另存工资表.xls"     '保存新建的工作表到本工作簿所在的文件夹中
    ActiveWorkbook.Close                                '关闭新建的工作簿
    
End Sub

二、运行结果

对Excel活动工作簿进行合并，汇总所有工作表，保存在工作簿最前，适用于同格式

合并工作簿中所有工作表

Sub 合并工作簿中所有工作表()
    '当前工作簿wb所有工作表ws合并保存至新建工作表（插入最前），但之前ws不修改（工作表格式相同）
    Dim wb, ws, title_row, end_row, copy_title, i
'--------------------参数填写：title_row，数字，第1行为1向下递增；end_row，数字
    title_row = 1  '表头行数，仅复制1次；如果为0，则表示没有表头或表头每次都复制
    end_row = 0    '表尾行数，不参与合并
    Set wb = Application.ActiveWorkbook  '当前工作簿即为待合并工作簿
    Set ws = wb.Worksheets.Add(before:=Sheets(1))  '最前添加新sheet，即为合并工作表
    ws.Name = "合并表"
    If title_row > 0 Then copy_title = True Else copy_title = False  '是否复制表头
    If title_row < 0 Then Debug.Print "title_row参数错误，必须为>=0的整数": Exit Sub
    Application.ScreenUpdating = False  '关闭屏幕更新，加快程序运行
    Application.DisplayAlerts = False   '不显示警告信息
    '遍历，复制表体
    For i = 1 To Worksheets.count:
        If Worksheets(i).Name <> ws.Name Then
            If copy_title = True Then  '复制表头，仅执行1次
                Worksheets(i).Rows(1 & ":" & title_row).Copy ws.Range("A1")
                copy_title = False
            End If
            '首行为空，会导致后续数据被覆盖
            If WorksheetFunction.CountA(ws.Rows(1)) = 0 Then ws.Rows(1).Delete
            write_row = ws.UsedRange.Rows.count + 1  '合并工作表的第一个空行写入
            sheet_row = Worksheets(i).UsedRange.Rows.count
            Worksheets(i).Rows(title_row + 1 & ":" & sheet_row - end_row).Copy ws.Range("A" & write_row)
        End If
    Next
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

合并文件夹下所有工作簿中所有工作表

Sub 合并文件夹下所有工作簿中所有工作表()
    '文件夹下所有工作簿wb所有工作表ws合并保存至新建工作表（但不含子文件夹），但不修改原数据（工作表格式相同）
    Dim wb, ws, title_row, end_row, copy_title, file_path, file_name, save_file, i
'--------------------参数填写：title_row，数字，第1行为1向下递增；end_row，数字；file_path，合并文件夹
    title_row = 1  '表头行数，仅复制1次；如果为0，则表示没有表头或表头每次都复制
    end_row = 0    '表尾行数，不参与合并
    file_path = "E:\测试\拆分表\"  '待合并工作簿所在的文件夹
    file_name = Dir(file_path & "*.xlsx") 
    If title_row > 0 Then copy_title = True Else copy_title = False  '是否复制表头
    If title_row < 0 Then Debug.Print "title_row参数错误，必须为>=0的整数": Exit Sub
    Application.ScreenUpdating = False  '关闭屏幕更新，加快程序运行
    Application.DisplayAlerts = False   '不显示警告信息
    Workbooks.Add    '新建工作表
    Set ws = ActiveSheet
    ws.Name = "合并表"
    Do While file_name <> ""
        Set wb = Workbooks.Open(file_path & file_name)
        For i = 1 To Worksheets.count:
            If copy_title = True Then  '复制表头，仅执行1次
                wb.Worksheets(i).Rows(1 & ":" & title_row).Copy ws.Range("A1")
                copy_title = False
            End If
            '首行为空，会导致后续数据被覆盖
            If WorksheetFunction.CountA(ws.Rows(1)) = 0 Then ws.Rows(1).Delete
            write_row = ws.UsedRange.Rows.count + 1  '合并工作表的第一个空行写入
            sheet_row = wb.Worksheets(i).UsedRange.Rows.count
            wb.Worksheets(i).Rows(title_row + 1 & ":" & sheet_row - end_row).Copy ws.Range("A" & write_row)
        Next
        wb.Close (False)
        file_name = Dir  '下一个文件名
    Loop
    '保存文件
    save_file = file_path & "合并表.xlsx"
    ws.Parent.SaveAs filename:=save_file
    ws.Parent.Close (False)
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

举例

1，合并《Excel·VBA按列拆分工作表》，sub1拆分后的工作表


合并sub1参数：title_row = 1，end_row = 0

2，合并《Excel·VBA按列拆分工作表》，sub2拆分后的工作表

合并sub2参数：title_row = 0，end_row = 0