sub 汇总多个工作簿()
Application.ScreenUpdating = False
Dim wb As Workbook, f As String, l As String, n As String, m As String, j As Integer
f = ThisWorkbook.Path & "\"
l = f & "*.xls"
m = Dir(l)
Do While m <> ""
If m <> ThisWorkbook.Name Then
n = f & m
Workbooks.Open (n)
With ThisWorkbook.activesheet
.Range("b4:at34").ClearContents
For i = 4 To .Range("a1").CurrentRegion.Rows.Count
For j = 2 To .Range("a1").CurrentRegion.Columns.Count - 2 Step 3
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then
aa = Left(wb.Name, InStrRev(wb.Name, ".") - 1)