|
发表于 2017-9-11 10:00
来自手机
|
显示全部楼层
Sub 汇总数据()
Application.ScreenUpdating = False
Dim wb, wb1 As Excel.Workbook
Dim sh As Excel.Worksheet
Dim d, arr
Set d = CreateObject("scripting.dictionary")
f = Dir(ThisWorkbook.Path & "\*" & "xl*") '生成查找EXCEL的目录
Do While f <> "" '在目录中循环
If f <> ThisWorkbook.Name Then '如果不是打开的工作簿
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f)
For Each sht In wb.Sheets '遍历打开文件的每一张表格
With ActiveSheet.Range("a1:b200")
Set Rng = .Find("姓名")
End With
If Not Rng Is Nothing Then
arr = WorksheetFunction.Transpose(Range("b2:b24"))
End If
Next sht
wb.Close
With ThisWorkbook.Sheets(1)
r = .Range("b65536").End(xlUp).Row + 1
Cells(r, 1) = r - 1
For i = 1 To 23
.Cells(r, i + 1) = arr(i)
Next
End With
End If
f = Dir
Loop
Application.ScreenUpdating = True
End Sub
|
|