c_c_lai

¦^´_ 1# starbox520

1. Option Explicit
   
2. 
   
3. Sub TT()
   
4.     Dim Mypa$, workName$, brr(1), pos As Long
   
5.     Dim t As Date, n As Long
   
6.    
   
7.     Const sWm As String = "\Rawdata\"
   
8.     t = Timer
   
9.     n = 0
   
10.     Mypa = ThisWorkbook.Path & sWm
    
11.     workName = Dir(Mypa & "*.xls")
    
12.     Sheet1.UsedRange.Offset(1).ClearContents
    
13.    
    
14.     Application.ScreenUpdating = False
    
15.     Do Until workName = ""
    
16.         'With GetObject(Mypa & workName)
    
17.         With Workbooks.Open(Mypa & workName)
    
18.             n = n + 1
    
19.             With .Sheets("Data")
    
20.                 brr(0) = .Range("a8").Resize(1, 21)
    
21.                 brr(1) = .Range("b19").Resize(1, 20)
    
22.             End With
    
23.             .Close False
    
24.         End With
    
25.         
    
26.         With Sheet1
    
27.             pos = .Cells(Rows.Count, 3).End(3).Row + 1
    
28.             .Range("c" & pos).Resize(1, 21) = brr(0)
    
29.             .Range("x" & pos).Resize(1, 20) = brr(1)
    
30.         End With
    
31.         Erase brr()
    
32.         workName = Dir
    
33.     Loop
    
34.     Application.ScreenUpdating = True
    
35.     MsgBox "¦@ªá" & Format(Timer - t, "0.000") & "¬í" _
    
36.             & Chr(10) & "§ä¨ì " & n & "µ§¸ê®Æ", vbOKCancel + vbInformation
    
37. End Sub

½Æ»s¥N½X