多个表格汇总到一个表格不同的sheet，vba宏

`Sub MergeWorkbookToSheets()
    Dim Path As String
    Dim Filename As String
    Dim Wb As Workbook
    Dim ws As Worksheet
    Dim ThisWb As Workbook
    Dim 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()
    Loop
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "汇总完成！", vbInformation
End Sub
``


使用说明：
打开Excel，按 Alt + F11 打开VBA编辑器

在左侧的"项目资源管理器"中，右键单击您的项目

选择"插入" → "模块"

将上面的代码完整复制粘贴到新模块中

确保路径正确：Path = "C:\Users\haifeng\OneDrive\桌面\测试bom\"

返回Excel，按 Alt + F8，选择"MergeWorkbookToSheets"宏并运行