求助多表数据合并

Hontyu

1. Sub 合并多表数据()
   
2.     Dim r, c As Long, Arr, Rng As Range
   
3.     Dim ToSht, Sht As Worksheet
   
4.     Set ToSht = Worksheets("汇总")
   
5.     ToSht.Rows("2:1048576").Clear
   
6.     For Each Sht In Worksheets
   
7.         If Sht.Name <> ToSht.Name Then
   
8.             r = Sht.Cells(Rows.Count, 2).End(3).Row
   
9.             c = Sht.UsedRange.Columns.Count + 1
   
10.             Arr = Sht.Range(Sht.Cells(2, 2), Sht.Cells(r, c)).Value
    
11.             Set Rng = ToSht.Cells(Rows.Count, 2).End(3).Offset(1)
    
12.             Rng.Resize(UBound(Arr), UBound(Arr, 2)) = Arr
    
13.         End If
    
14.     Next Sht
    
15.     Worksheets("汇总").Columns.AutoFit
    
16.     Worksheets("汇总").Activate
    
17. End Sub

复制代码

anshilin

Hontyu 发表于 2022-5-26 14:15
这样子还是？

就是这样子的

anshilin

Hontyu 发表于 2022-5-26 14:15
这样子还是？

能否用公式合并呢

Hontyu

anshilin 发表于 2022-5-26 15:35
能否用公式合并呢

已经发了个VBA代码了，好像在审核中，论坛。

高个子

anshilin 发表于 2022-5-26 15:35
能否用公式合并呢

公式需要你手动把表名改成有规律的数字，比如123456789，否则你的版本需要VBA解决，2010或者2013可以下载power query插件解决

Hontyu

同一工作薄合并各报表数据，一般用VBA或者PQ。不管你有多少个报表，多少个报表名。只要表格结构规范，都非常简单。

anshilin

谢谢大家！！！！

Hontyu

1. Sub 合并多表数据()
   
2.     Dim r, c As Long, Arr, Rng As Range
   
3.     Dim ToSht, Sht As Worksheet
   
4.     Set ToSht = Worksheets("汇总")
   
5.     ToSht.Rows("2:1048576").Clear
   
6.     For Each Sht In Worksheets
   
7.         If Sht.Name <> ToSht.Name Then
   
8.             r = Sht.Cells(Rows.Count, 2).End(3).Row
   
9.             c = Sht.UsedRange.Columns.Count + 1
   
10.             Arr = Sht.Range(Sht.Cells(2, 2), Sht.Cells(r, c)).Value
    
11.             Set Rng = ToSht.Cells(Rows.Count, 2).End(3).Offset(1)
    
12.             Rng.Resize(UBound(Arr), UBound(Arr, 2)) = Arr
    
13.         End If
    
14.     Next Sht
    
15.     Worksheets("汇总").Columns.AutoFit
    
16.     Worksheets("汇总").Activate
    
17. End Sub
    

复制代码