对同一文件夹下多个工作簿提取数据并汇总，在线等

dokich

跪求老师们帮小弟用VBA   对指定路径下的所有工作簿中sheet1的数据进行提取

在线等~在这里先谢过了！~
FoxHo.zip (23.95 KB, 下载次数: 14)

2017-1-14 12:11 上传

点击文件名下载附件
人员统计表：



数据源路径:


数据源表（统一格式的）：
      

dsmch

1. Sub Macro1()
   
2. Set sht = ThisWorkbook.Sheets(1)
   
3. arr = sht.Range("a1").CurrentRegion
   
4. mypath = ThisWorkbook.Path & "\data1"
   
5. wj = Dir(mypath & "*.xls*")
   
6. Application.ScreenUpdating = False
   
7. Do While wj <> ""
   
8.     s = s + 1
   
9.     With Workbooks.Open(mypath & wj)
   
10.         For i = 1 To UBound(arr, 2)
    
11.             Set rng = .Sheets(1).UsedRange.Find(arr(1, i))
    
12.             If Not rng Is Nothing Then sht.Cells(s + 1, i) = rng.Offset(0, 1)
    
13.         Next
    
14.         .Close 0
    
15.     End With
    
16.     wj = Dir
    
17. Loop
    
18. Application.ScreenUpdating = True
    
19. End Sub

复制代码

dsmch

………………

dokich

dsmch 发表于 2017-1-14 15:35

已经解决了，谢谢大神。

王英wang

好厉害