[已解决]在不同工作簿中提取其中某一工作表的所有数据

zxl_8487 · 发表于 2017-9-4 10:23

本帖最后由 zxl_8487 于 2017-9-4 13:29 编辑

各位论坛老师，麻烦请教下，如何用VBA实现在不同工作簿中提取其中某一工作表的所有数据。如下图所示：

1.文件夹中有11个文件，其中有10个店铺明细表（可能更多），一个汇总表（目前为空）；

2.每个店铺明细表中有3个工作表（有可能更多），其中一个工作表名称固定为“店铺汇总表”；

3.汇总表中目前有一个工作表名称固定为“各店铺汇总表”。

要求：

使用VBA实现自动将文件夹内所有店铺明细表“店铺汇总表”中的有效数据自动提取至汇总表“各店铺汇总表”。

望各位大神不吝赐教，万分感谢！！！

最佳答案

月排行榜 / 总排行榜

grf1973

2017-9-4 20:04

按要求作了修改。加了容错，子文件夹搜索。
另外重复提取的要求已经做过说明。是清除内容后“重新”提取，而不是“重复”提取。

跳转到最佳答案楼层

chart888 · 发表于 2017-9-4 13:35

见附件

zxl_8487 · 发表于 2017-9-4 14:04

chart888 发表于 2017-9-4 13:35
见附件

非常感谢您的回复，有个问题想请教下是否可以调整下：按照您给的回复，10个明细表需要全部打开才能正确提取，若打开一个明细表，点击“按钮1”则是在原来的基础上又重复提取了遍打开的明细表。是否可以：1.不打开工作簿提取数据；2.重新点击提取数据的按钮时仅是对数据进行刷新，不要再重复提取。
再次感谢。

grf1973 · 发表于 2017-9-4 15:17

不打开工作簿，秒提取。
另外如果考虑不重新提取，而是刷新的话，反而会因为添加判断（需判断提取出来的内容是否已提取过）影响速度，不如全部清光后重新提取一遍。

zxl_8487 · 发表于 2017-9-4 16:15

本帖最后由 zxl_8487 于 2017-9-4 19:30 编辑

grf1973 发表于 2017-9-4 15:17
不打开工作簿，秒提取。
另外如果考虑不重新提取，而是刷新的话，反而会因为添加判断（需判断提取出来的内 ...

非常感谢，您现在做的完全符合我现在的想法

如果大神有时间的话，麻烦能不能帮忙稍微改进下：1.如果当前文件夹的子文件夹中也有对应的明细表（子文件夹名称不固定，但是要提取的工作表的名称是一致的，如附件），可否一并取过来；
2.如果文件夹中某一工作簿没有目标工作表（没有工作表名称的为“门店汇总表”），能否自动跳过该工作簿，不提示错误，继续往下进行。
万分感谢。

ppp710715 · 发表于 2017-9-4 17:17

Sub test1()
Application.ScreenUpdating = False
Set aw = ThisWorkbook
'以下遍历文件，提取各数据
aw.Sheets(1).[a2:p10000].ClearContents
n = 1
aw.Sheets(1).[a2:a10000].NumberFormatLocal = "yyyy-m-d"
p = aw.Path & ""
f = Dir(p & "*.xls")
Do While f <> ""
If f <> ThisWorkbook.Name Then
Set wk = GetObject(p & f)
wk.Sheets(1).Activate
lr = wk.Sheets(1).Cells(Rows.Count, 1).End(3).Row
n = n + 1
aw.Sheets("各店铺汇总").Range("a" & n).Resize(lr - 1, 16) = wk.Sheets(1).Range("a2").Resize(lr - 1, 16).Value
wk.Close False
End If
n = aw.Sheets("各店铺汇总").Cells(Rows.Count, 1).End(3).Row
f = Dir
Loop
Application.ScreenUpdating = True
MsgBox "汇总完毕！"
End Sub