register313

¦^´_ 1# eg0802

§Q¥ÎVBA

1. Sub MergeBook()
   
2. Dim MyPath$, MyName$, wb As Workbook, sh As Worksheet, sht As Worksheet
   
3. Set wb = ThisWorkbook
   
4. MyPath = ThisWorkbook.Path & "\"
   
5. MyName = Dir(MyPath & "*.xls")
   
6. Application.ScreenUpdating = False
   
7. Application.DisplayAlerts = False
   
8. For Each sh In Sheets
   
9.   If sh.Name <> ActiveSheet.Name Then sh.Delete
   
10. Next
    
11. Do While MyName <> ""
    
12.   If MyName <> ThisWorkbook.Name Then
    
13.      With GetObject(MyPath & MyName)
    
14.        For Each sht In .Sheets
    
15.            sht.Copy After:=wb.Sheets(wb.Sheets.Count)
    
16.        Next
    
17.        .Close False
    
18.      End With
    
19.   End If
    
20.   MyName = Dir
    
21. Loop
    
22. Application.DisplayAlerts = True
    
23. Application.ScreenUpdating = True
    
24. End Sub

½Æ»s¥N½X

¦X¨Ö¬¡­¶Ã¯.rar (9.64 KB)

¤U¸ü¦¸¼Æ: 44

2012-5-23 19:10

register313

¦^´_ 5# alumi

¥¿½T