求教一个汇总表格用的宏

lxt1989714 · 发表于 2016-11-28 11:48

所有的表格都是.xlsx格式的，需要把每个文件里的“成本单（表3）”这张表粘贴出来。
因为表格表头都是统一的。所以只需要把这张表的数据都粘下来即可，纵向排列。
汇总之后的大概样子就是类似手动整行复制粘贴一样的。（差不多每个文件都是复制10-15行）
自己手动复制录制宏之后发现里面实际上带有文件名的链接，没法一次性汇总文件夹里全部的信息。
求助。。。附件里放有需要汇总的表格的样式，和汇总之后的样子。

~河北汇总文件03.rar (211.34 KB, 下载次数: 45)

ykqrs · 发表于 2016-11-28 12:57

Sub qq()
Cells.Clear
Dim mapath$, maname$, wb As Workbook, ws As Worksheet, s$, r%
Application.ScreenUpdating = False
Application.DisplayAlerts = False
mapath = ThisWorkbook.Path & ""
maname = Dir(mapath & "*初审*.xlsx")
Do While maname <> ""
If maname <> ThisWorkbook.Name Then
r = r + 1
Set wb = Workbooks.Open(mapath & maname)
For Each ws In wb.Sheets
s = ws.Name
If InStr(s, "表3") Then
ws.[a1].CurrentRegion.Copy Range("a" & r)
End If
Next
End If
wb.Close
maname = Dir
r = Cells(Rows.Count, 1).End(xlUp).Row
Loop
End Sub

复制代码

lxt1989714 · 发表于 2016-11-28 13:02

谢谢，马上试试。

ykqrs · 发表于 2016-11-28 13:11

汇总后样例.rar (22.95 KB, 下载次数: 18)

ykqrs · 发表于 2016-11-28 13:24

网页刷新太慢，把r=r+1改成r=r+2

lxt1989714 · 发表于 2016-11-28 13:51

本帖最后由 lxt1989714 于 2016-11-28 13:54 编辑

麻烦确认一下。。。刚试用了一下。。。运行没有报错。。。但是表格里一直是空的。。。

汇总文件.rar (933.8 KB, 下载次数: 15)

ykqrs · 发表于 2016-11-28 18:08

Sub qq()
Cells.Clear
Dim mapath$, maname$, wb As Workbook, ws As Worksheet, s$, r%
Application.ScreenUpdating = False
Application.DisplayAlerts = False
mapath = ThisWorkbook.Path & ""
maname = Dir(mapath & "*初审*.xlsx")
Do While maname <> ""
If maname <> ThisWorkbook.Name Then
r = r + 2
Set wb = Workbooks.Open(mapath & maname)
For Each ws In wb.Sheets
s = ws.Name
If InStr(s, "成本单（表3）") Then
ws.[a1].CurrentRegion.Copy ThisWorkbook.Sheets("sheet1").Range("a" & r)
End If
Next
End If
wb.Close
maname = Dir
r = Cells(Rows.Count, 1).End(xlUp).Row
Loop
End Sub

复制代码

ykqrs · 发表于 2016-11-28 18:09

第15行代码改一下

15.ws.[a1].CurrentRegion.Copy ThisWorkbook.Sheets("sheet1").Range("a" & r)

复制代码

ykqrs · 发表于 2016-11-28 18:13

代码速度很慢，明天抽时间给你用数组做一下，看看能不能快一点

lxt1989714 · 发表于 2016-11-29 10:19

嗯好的，谢谢啦

		自动登录	找回密码
密码			免费注册

[Excel基础] 求教一个汇总表格用的宏