`Sub MergeWorkbookToSheets()Dim Path As StringDim Filename As StringDim Wb As WorkbookDim ws As WorksheetDim ThisWb As WorkbookDim Newsheet As Worksheet'设置目标文件夹路径，请修改为您的实际路径Path = "C:\Users\haifeng\OneDrive\桌面\测试bom\" '注意：路径末尾必须以反斜杠"\"结束Filename = Dir(Path & "*.xls*") '获取所有Excel文件（包括.xls和.xlsx）Set ThisWb = ThisWorkbook '当前工作簿Application.ScreenUpdating = False '关闭屏幕更新，加快速度Application.DisplayAlerts = False '关闭提示，避免覆盖提示Do While Filename <> ""'打开源文件Set Wb = Workbooks.Open(Path & Filename)'遍历源文件中的每一个工作表For Each ws In Wb.Worksheets'在当前汇总工作簿中创建一个新Sheet，并以"文件名_原表名"命名Set Newsheet = ThisWb.Sheets.Add(After:=ThisWb.Sheets(ThisWb.Sheets.Count))'Left函数用于去掉.xlsx后缀Newsheet.Name = Left(Filename, Len(Filename) - 4) & "_" & ws.Name'复制整个工作表内容ws.UsedRange.Copy Newsheet.Range("A1")Next ws'关闭源文件，不保存Wb.Close SaveChanges:=False'获取下一个文件名Filename = Dir()LoopApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueMsgBox "汇总完成！", vbInformation
End Sub
``使用说明：
打开Excel，按 Alt + F11 打开VBA编辑器在左侧的"项目资源管理器"中，右键单击您的项目选择"插入" → "模块"将上面的代码完整复制粘贴到新模块中确保路径正确：Path = "C:\Users\haifeng\OneDrive\桌面\测试bom\"返回Excel，按 Alt + F8，选择"MergeWorkbookToSheets"宏并运行