做数据汇总遇到的问题，请大家帮帮忙！

各位大侠：
      因为我们的产品是模块组合式制造，因此在做bom表时要根据总成的名称一个一个到文件夹中寻找然后在拷贝，工作量非常大，能否请高手按附件中的要求帮谢一段程序？请大家帮帮忙！

[ 本帖最后由 kuilinq 于 2011-8-11 12:55 编辑 ]

短信收到，请测试：
Sub Macro1()
    Dim MyPath$, MyName$, sh As Worksheet, sht As Worksheet, arr, d As Object, ds As Object, dic As Object, lr&
    Set d = CreateObject("scripting.dictionary")
    Set ds = CreateObject("scripting.dictionary")
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet1")
        arr = .Range("a3:a" & [a65536].End(3).Row)
    End With
    For i = 1 To UBound(arr)
        d(Left(arr(i, 1), 4)) = i
        ds(arr(i, 1) & ".xls") = i
    Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each sht In Sheets
        If sht.Name <> ActiveSheet.Name Then sht.Delete
    Next
    MyPath = ThisWorkbook.Path & "\明细表数据\"
    MyName = Dir(MyPath & "*.xls")
    Do While MyName <> ""
        If d.Exists(Left(MyName, 4)) Then
            If Not dic.Exists(Left(MyName, 4)) Then
                Sheets.Add(After:=Sheets(Sheets.Count)).Name = Left(MyName, 4)
                Set dic(Left(MyName, 4)) = ActiveSheet
            End If
            With GetObject(MyPath & MyName)
                Set sht = dic(Left(MyName, 4))
                For Each sh In .Sheets
                    If IsSheetEmpty = IsEmpty(sh.UsedRange) Then
                        If ds.Exists(MyName) Then
                            sh.[a1].CurrentRegion.Copy sht.[a65536].End(3).Offset(1)
                        Else
                            lr = sht.[a65536].End(3).Row
                            sh.[a1].CurrentRegion.Copy sht.Cells(lr + 3, 1)
                            sht.Cells(lr + 2, 2) = Split(MyName, ".")(0)
                        End If
                    End If
                Next
                .Close False
            End With
        End If
        MyName = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox "ok"
End Sub

思路有所不同，每个大类占用一张工作表，请看附件
数据汇总（感觉太难）.rar (45.31 KB)

非常感谢！我看看先。。。

感谢版主的帮忙！意思是对的,OK!
另外在问问：
   1、要是每个大类都是放置在同一个工作表中如何修改程序；
   2、问题我重新发出，见复件