把多个工作簿合并到一个工作簿作为新工作簿的一张表（宏代码）Sub 合并当前目录下所有工作簿的全部工作表（） Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String Application。ScreenUpdating = False MyPath = ActiveWorkbook.Path MyName = Dir（MyPath ＆ "\" ＆ "*。xls"） AWbName = ActiveWorkbook。Name Num = 0 Do While MyName <> "" If MyName <> AWbName Then Set Wb = Workbooks.Open（MyPath ＆ "\” & MyName） Num = Num + 1 With Workbooks(1).ActiveSheet 。Cells(。Range(”A65536"）。End（xlUp).Row + 2， 1） = Left(MyName, Len(MyName) — 4) For G = 1 To Sheets。Count Wb.Sheets（G）.UsedRange.Copy 。Cells（。Range(”A65536”）.End(xlUp).Row + 1, 1) Next WbN = WbN ＆ Chr(13) ＆ Wb。Name Wb。Close False End With End If MyName = Dir Loop Range（"A1”).Select Application。ScreenUpdating = True MsgBox " 共 合 并 了 ” ＆ Num ＆ " 个 工 作 薄 下 的 全 部 工 作 表 . 如 下 :” ＆ Chr(13) & WbN ， vbInformation, ”提示" End Sub 具体操作：在工作簿目录下新建一工作簿,工具—--宏—---编辑器—---插入-模块-—-粘贴代码==运行excel 如何将一个工作簿中的多个工作表合并到一张工作表上打开你的工作簿 新建一个工作表 在这个工作表的标签上右键 查看代码 你把下面的代码复制到里边去，然后 上面有个运行 运行子程序就可以了，代码如下，假如 出现问题你可以尝试工具 宏 宏安全性里把那个降低为中或者低再试试Sub 合并当前工作簿下的所有工作表（)Application。ScreenUpdating = FalseFor j = 1 To Sheets.Count If Sheets(j）.Name 〈〉 ActiveSheet。Name Then X = Range(”A65536”)。End(xlUp).Row + 1 Sheets（j）.UsedRange.Copy Cells(X, 1) End IfNextRange（"B1”）。SelectApplication。ScreenUpdating = TrueMsgBox ”当前工作簿下的全部工作表已经合并完毕!”, vbInformation, ”提示”End Sub把同一工作簿多张工作表合并到同一张工作表1 新建一个工作表放在最左边，ALT + F11 键打开代码框--插入—-模块—-复制以下...
