[已解决]求助汇总多张表内容，谢谢

zhycl

“单位1”“单位2”“单位3”为数据源，实际应用中会存在多个，我现在需要把数据源中的内容汇总到“汇总表”中，详见汇总表中的说明，数据源表的格式都是一样的，但是行数不定，最后都以合计结束。求助一下各位老师，谢谢了 新建文件夹 (2).rar (13.11 KB, 下载次数: 11)

2014-3-31 11:27 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-3-31 12:09

………………

跳转到最佳答案楼层

Banieliang

提供这个给你参考
考勤表.rar (51.9 KB, 下载次数: 12)

2014-3-31 11:47 上传

点击文件名下载附件

dsmch

1. Sub Macro1()
   
2. Dim wb As Workbook, mypath$, wj, n&, x&
   
3. mypath = ThisWorkbook.Path & ""
   
4. wj = Dir(mypath & "*.xls")
   
5. n = 5
   
6. Application.ScreenUpdating = False
   
7. [a5:f20000].Clear
   
8. Do While wj <> ""
   
9.     If wj <> ThisWorkbook.Name Then
   
10.         Set wb = GetObject(mypath & wj)
    
11.         dw = Replace(wb.Name, ".xls", "")
    
12.         With wb.Sheets(1)
    
13.             x = .Range("a5").End(xlDown).Row
    
14.             Cells(n, 1).Resize(x - 4) = dw
    
15.             .Range(.Cells(5, 1), .Cells(x, 6)).Copy Cells(n, 2)
    
16.         End With
    
17.         n = Range("b65536").End(xlUp).Row + 1
    
18.         wb.Close 0
    
19.     End If
    
20. wj = Dir
    
21. Loop
    
22. Cells(n, 2) = "合计"
    
23. For i = 3 To 5
    
24.     Cells(n, i) = Application.Sum(Cells(5, i).Resize(n - 5))
    
25. Next
    
26. With Range("a5:f" & n).Borders()
    
27.     .LineStyle = xlContinuous
    
28.     .Weight = xlThin
    
29. End With
    
30. Application.ScreenUpdating = True
    
31. End Sub
    

复制代码

dsmch

………………

tgydslr

学习学习

zhycl

dsmch 发表于 2014-3-31 12:09
………………

你好，很感谢您的帮助，但是我实际测试了一下发现，汇总表中把有的源数据表中的 “合计”那一行也取数了，但实际中不需要取数，取数范围应为第5行（含）开始直到“合计”上面的最后一行带有“申报项目”的行。能再为改改吗？谢谢

dsmch

zhycl 发表于 2014-4-1 08:40
你好，很感谢您的帮助，但是我实际测试了一下发现，汇总表中把有的源数据表中的 “合计”那一行也取数了， ...

附件测试没有问题，上传实际附件