[已解决]VBA 如何将多个工作薄的数据汇总到一个新的工作薄中

杨晨 · 发表于 2012-9-7 10:46

我想把比如20个工作薄（放在同一个文件夹下面，但是文件名不同，用日期区分）里面的同一个工作表比如sheet1里面的所有数据都按照顺序（例如依照a列里面的数据按照从小到大顺序排列，一共有5列对应数据）放在一个新的工作薄中，怎么实现？

最佳答案

5201314

2012-9-7 17:57

本帖最后由 5201314 于 2012-9-7 17:59 编辑

Sub 合并多工作簿及多工作表()
Dim MyPath As String, MyFile As String, i As Integer
Dim Wb As Workbook, arr
Application.ScreenUpdating = False
MyPath = ThisWorkbook.Path
MyFile = Dir(MyPath & "\*.xls")
Do Until MyFile = ""
If MyFile <> ThisWorkbook.Name Then
Set Wb = Workbooks.Open(MyPath & "" & MyFile)
For i = 1 To Wb.Worksheets.Count
arr = Sheets(i).UsedRange
ThisWorkbook.Sheets(i).Range("A" & rows.count).End(xlUp).Offset(1).Resize(UBound(arr), UBound(arr, 2)) = arr
Next
Wb.Close
End If
MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub

复制代码

hwc2ycy · 发表于 2012-9-7 15:35

你遍历当前当前打开的工作簿下的目录下所有的EXCEL文件，然后逐个打开，复制需要的数据到数组，全部读完后再写入数据到工作表里，逐个循环就行了。

杨晨 · 发表于 2012-9-7 17:22

能够给一个VBA代码吗？

5201314 · 发表于 2012-9-7 17:57

本帖最后由 5201314 于 2012-9-7 17:59 编辑

Sub 合并多工作簿及多工作表()
Dim MyPath As String, MyFile As String, i As Integer
Dim Wb As Workbook, arr
Application.ScreenUpdating = False
MyPath = ThisWorkbook.Path
MyFile = Dir(MyPath & "\*.xls")
Do Until MyFile = ""
If MyFile <> ThisWorkbook.Name Then
Set Wb = Workbooks.Open(MyPath & "" & MyFile)
For i = 1 To Wb.Worksheets.Count
arr = Sheets(i).UsedRange
ThisWorkbook.Sheets(i).Range("A" & rows.count).End(xlUp).Offset(1).Resize(UBound(arr), UBound(arr, 2)) = arr
Next
Wb.Close
End If
MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub

复制代码

杨晨 · 发表于 2012-9-10 11:25

运行良好，高手！高手！佩服佩服！

dzrjf · 发表于 2013-10-29 14:36

合并时，但把标题同事统计进去了，在改进就更好了

dzrjf · 发表于 2013-10-29 14:36

google_852 · 发表于 2013-11-17 15:07

谢谢
我先下，

莫默1234 · 发表于 2014-1-14 11:20

我的是只需要每个表里面的三列，将24个表里相同位置的3列放到一个数组中，怎么实现啊？新手请求赐教

yytax2010 · 发表于 2014-1-15 20:59

数据量大时提示：运行时错误'1004':应用程序定义或对象定义错误。去表头怎样修改？

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