汇总多个excel文件的信息---合并相同格式的不同工作簿

小手拨凉

图片是合并后的样子，之前是由3个不同的工作簿的来的信息
可以看下附件   

这只是3个人的报告的汇总。实际几十个人，大约几百甚至上千行，所以用"复制+黏贴"的方式有点慢，能否有一种方法把放在一个文件夹内的所有相同格式的excel文件一下子汇集到一起？

Monthly Reports.rar (744.45 KB, 下载次数: 5)

2013-7-10 21:32 上传

点击文件名下载附件

小手拨凉

，谢谢     

小手拨凉

不好意思，发错附件和相片了，已经从新修改了原文，请大家帮忙看下，谢谢了

fxl447098457

小手拨凉 发表于 2013-7-10 21:00
不好意思，发错附件和相片了，已经从新修改了原文，请大家帮忙看下，谢谢了

附件无法读取.下载不了你的附件。

小手拨凉

fxl447098457 发表于 2013-7-10 21:17
附件无法读取.下载不了你的附件。

谢谢您的提醒，已经修改了
试验了一下，下载没问题，请帮我看下，谢谢

fxl447098457

小手拨凉 发表于 2013-7-10 21:33
谢谢您的提醒，已经修改了
试验了一下，下载没问题，请帮我看下，谢谢

1. Sub HzWb()
   
2.     Dim bt As Range, r As Long, c As Long
   
3.     r = 10
   
4.     c = 20
   
5.     Range(Cells(r + 1, "A"), Cells(65536, c)) = "" ' 清除汇总表中原表数据
   
6.     Application.ScreenUpdating = False
   
7.     Dim FileName As String, wb As Workbook, Erow As Long, fn As String, arr As Variant
   
8.     FileName = Dir(ThisWorkbook.Path & "\*.xls")
   
9.     Do While FileName <> ""
   
10.         If FileName <> ThisWorkbook.Name Then    ' 判断文件是否是本工作簿
    
11.             Erow = Range("A65536").End(xlUp).Row + 1  ' 取得汇总表中第一条空行行号
    
12.             fn = ThisWorkbook.Path & "" & FileName
    
13.             Set wb = GetObject(fn)    ' 将fn 代表的工作簿对象赋给变量
    
14.             Set sht = wb.Worksheets(1)    ' 汇总的是第1 张工作表
    
15.             ' 将数据表中的记录保存在arr 数组里
    
16.             arr = sht.Range(sht.Cells(r + 1, "A"), sht.Cells(65536, "T").End(xlUp))
    
17.             ' 将数组arr 中的数据写入工作表
    
18.             Cells(Erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    
19.             wb.Close False
    
20.         End If
    
21.         FileName = Dir    ' 用Dir 函数取得其他文件名，并赋给变量
    
22.     Loop
    
23.     Application.ScreenUpdating = True
    
24. End Sub
    

复制代码

fxl447098457

效果见附件。

WilliamGuo2023

fxl447098457 发表于 2013-7-10 21:52

不知道为什么我复制到EXCEL宏里面去就是乱码，复制到其他文件就可以正常粘贴，