|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
需求: 文件夹下有多个工作簿,每个工作簿中有8-10个工作表,只想汇总这么多工作簿中某一个相同名字的工作表(比如图中的7部)
方案&问题:在论坛中看到 多工作簿指定“sheet1” 汇总的代码(代码如下),尝试把标黄的部分改成7或者工作表名称后,代码报错下标越界,请帮忙看看是什么问题,代码改怎么修改或者编写能达到想要的结果呢?谢谢~~
- Sub Summary()
- Dim bt As Range, r As Long, c As Long
- r = 2
- c = 13
- Dim wt As Worksheet
- <font style="background-color: orange;">Set wt = ThisWorkbook.Worksheets(1) </font>
- wt.Rows(r + 1 & ":1048576").ClearContents
- Application.ScreenUpdating = False
- Dim filename As String, sht As Worksheet, wb As Workbook
- Dim erow As Long, fn As String, arr As Variant
- filename = Dir(ThisWorkbook.Path & "\*.xlsx")
- Do While filename <> ""
- If filename <> ThisWorkbook.Name Then
- erow = wt.Range("A1").CurrentRegion.Rows.Count + 1
- fn = ThisWorkbook.Path & "" & filename
- Set wb = GetObject(fn)
- <font style="background-color: orange;"> Set sht = wb.Worksheet(1)</font>
-
- arr = sht.Range(sht.Cells(r + 1, "A"), sht.Cells(1048576, "B").End(xlUp).Offset(0, 5))
- wt.Cells(erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
- wb.Close False
- End If
- filename = Dir
- Loop
- Application.ScreenUpdating = True
-
- End Sub
复制代码
|
-
工作簿样式
|