打开需要合并的表格打开宏编辑器或者快捷键altf11左表树表右键模块插入模块粘贴代码执行注意原表格的筛选会被撤销可以打开表格后先保存下然后执行代码完毕后关闭源表再打开源表这样源表的筛选可以保留Sub MergeAllSheetsToNewWorkbook()Dim wbSource As WorkbookDim wbNew As WorkbookDim wsSource As WorksheetDim wsDest As WorksheetDim lastRowSource As LongDim lastRowDest As LongDim isFirstSheet As Boolean 设定当前工作簿为源文件Set wbSource ActiveWorkbook 获取源工作簿文件名表格名称sourceFileName wbSource.Name 创建一个全新的工作簿Set wbNew Workbooks.Add 设定新工作簿的第一个标签页为目标页Set wsDest wbNew.Worksheets(1)lastRowDest 1Application.ScreenUpdating False 以关闭屏幕刷新。 遍历源工作簿中的每一个标签页For Each wsSource In wbSource.Worksheets 检查该页是否为空只处理有数据的页If Application.WorksheetFunction.CountA(wsSource.UsedRange) 0 Then 1. 记录原始状态是否开启了筛选箭头hasFilter wsSource.AutoFilterMode 2. 如果当前有筛选即某些行被隐藏了则显示所有数据If wsSource.FilterMode ThenwsSource.ShowAllDataEnd IflastRowSource wsSource.Cells(wsSource.rows.Count, A).End(xlUp).Row从第1行开始复制wsSource.UsedRange.Copy Destination:wsDest.Range(C lastRowDest)复制页签名wsSourceName wsSource.NamewsDest.Range(B lastRowDest).Resize(lastRowSource, 1).value wsSourceName’根据合并的表格页签自动按行分组wsDest.Range(B lastRowDest 1).Resize(lastRowSource - 1, 1).GrouplastRowDest wsDest.Cells(wsDest.rows.Count, C).End(xlUp).Row 1End IfNext wsSource复制表名wsDest.Range(A1).Resize(lastRowDest - 1, 1).value sourceFileNameMsgBox lastRowDestActiveWindow.View xlPageBreakPreview 切换到 分页预览 模式最直观Application.ScreenUpdating True 打开屏幕刷新。End Sub