|
先来一个吧。
- Sub 汇总()
- Dim FilName As String, PathStr As String
- Dim m%, n&
- Dim arr
- Dim Wbook As Object, Sht As Worksheet
- Application.ScreenUpdating = False
- With ThisWorkbook
- For Each Sht In .Worksheets
- With Sht
- If .Name <> "汇总" Then
- .Range("A4:F" & .Cells(Rows.Count, 2).End(xlUp).Row + 1).ClearContents
- End If
- End With
- Next
- End With
- PathStr = ThisWorkbook.Path & ""
- FilName = Dir(PathStr & "*.xls*")
- Do While FilName <> ""
- If FilName <> ThisWorkbook.Name Then
- m = m + 1 '工作簿计数
- Set Wbook = GetObject(PathStr & FilName) '获取找到的工作簿
- For Each Sht In Wbook.Worksheets '对工作簿里的工作表进行循环取值
- With Sht
- arr = .Range("B4:F" & .Cells(Rows.Count, 2).End(xlUp).Row)
- End With
- With ThisWorkbook.Worksheets(Sht.Name)
- n = .Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row '获取对应工作表里第一个非空行
- .Range("B" & n).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
- .Range("A" & n).Resize(UBound(arr, 1), 1) = "=N(" & .Range("A" & n - 1).Address(0, 0) & ")+1"
- End With
- Next
- Wbook.Close False '取完数据后关闭工作簿。
- End If
- FilName = Dir
- Loop
- Application.ScreenUpdating = True
- MsgBox "所有工作簿已经汇总完毕!共计汇总了" & m & "个工作簿。"
- End Sub
复制代码 |
|