|
Sub Macro1()
Dim mypath$, wj$, arr(1 To 20000, 1 To 32)
Dim wb As Workbook, s&
mypath = ThisWorkbook.Path & "\"
wj = Dir(mypath & "*.xls*")
Application.ScreenUpdating = False
Do While wj <> ""
If wj <> ThisWorkbook.Name Then
s = s + 1
Set wb = GetObject(mypath & wj)
brr = wb.Sheets(1).Range("a2").CurrentRegion
wb.Close 0
arr(s, 1) = s
arr(s, 2) = brr(10, 3)
'arr(s, 3) = brr(8, 3)
arr(s, 4) = brr(8, 3)
arr(s, 5) = brr(1, 3)
'以下类推
End If
wj = Dir
Loop
[a3:af20000].ClearContents
Range("a3").Resize(s, 32) = arr
Application.ScreenUpdating = True
End Sub
|
|