不同类型的多个工作薄数据汇总到一个表里按顺序排列

mfkdrgw

4种类型的表数据放到一个表里面

mfkdrgw

朱荣兴 发表于 2018-9-24 14:09
这么几个文件，手工拷贝还不要写代码的时间的，

不只是这几个文件的事，有很多呢，但主要是这4种类型。每个类型我只列举了3个而已。。。一个个的拷贝很费时间啊

不知道为什么

mfkdrgw 发表于 2018-9-24 14:15
不只是这几个文件的事，有很多呢，但主要是这4种类型。每个类型我只列举了3个而已。。。一个个的拷贝很费 ...

            

不知道为什么

mfkdrgw 发表于 2018-9-24 14:15
不只是这几个文件的事，有很多呢，但主要是这4种类型。每个类型我只列举了3个而已。。。一个个的拷贝很费 ...

代码参考

1. Sub 汇总()
   
2.     Dim Arr, Fn, Owbk As Workbook, Wbk As Workbook
   
3.     Dim MyPath$, RowSum%, NumR$, NumC&
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     Set Owbk = ThisWorkbook
   
7.     MyPath = Owbk.Path & ""
   
8.     Fn = Dir(MyPath & "*.xl*")
   
9.     Owbk.Sheets(1).Cells.Clear
   
10.     Do While Fn <> ""
    
11.         If Fn <> Owbk.Name Then
    
12.             Set Wbk = Workbooks.Open(MyPath & Fn)
    
13.             With Wbk
    
14.                 Arr = .Sheets(1).UsedRange
    
15.                 .Close False
    
16.                 NumR = UBound(Arr)
    
17.                 NumC = UBound(Arr, 2)
    
18.                 Owbk.Sheets(1).Cells(1, 1).Offset(RowSum + 1, 0).Resize(NumR, NumC) = Arr
    
19.                 RowSum = RowSum + NumR
    
20.             End With
    
21.         End If
    
22.         Fn = Dir
    
23.     Loop
    
24.     Application.DisplayAlerts = True
    
25.     Application.ScreenUpdating = True
    
26. End Sub

复制代码

不知道为什么

代码审核中，附件供测试

要求：数据合并在此.zip (18.22 KB, 下载次数: 45)

2018-9-24 14:48 上传

点击文件名下载附件

mfkdrgw

不知道为什么 发表于 2018-9-24 14:48
代码审核中，附件供测试

对，就是这个效果