请教如何将多个表中数据合并到一个表中

twh14

如图所示，文件中有明细表（20020202、20020203……）若干，如何能快速合并到明细汇总表内，并增加一列为每个明细表的表名（样本数据见明细汇总表）。

syj2004hg

1. Sub UnionSht()
   
2.     Dim i As Integer, j As Integer, m As Integer
   
3.     Dim sht As Worksheet
   
4.     Dim arr(1 To 10000, 1 To 10)
   
5.     For Each sht In Worksheets
   
6.         If sht.Name = "明细汇总" Then Exit For
   
7.         With sht
   
8.             For i = 1 To .Range("B10000").End(xlUp).Row - 2
   
9.                 For j = 2 To 10
   
10.                     arr(m + i, 1) = .Name
    
11.                     arr(m + i, j) = .Cells(i + 2, j).Value
    
12.                 Next
    
13.             Next
    
14.             m = m + i - 1
    
15.         End With
    
16.     Next
    
17.     Worksheets("明细汇总").Range("B2").Resize(10000, 10).Value = arr
    
18. End Sub

复制代码

donghui2363

Sub 汇总()
Dim sht As Worksheet
ReDim arr(1 To 10000, 1 To 12)
ReDim crr(1 To 100)
    For Each sht In Sheets
        If Left(sht.Name, 2) = 20 Then
            k = k + 1
            crr(k) = sht.Name
        End If
    Next
        For n = k To 1 Step -1
            r = Sheets(crr(n)).Range("a65536").End(xlUp).Row
            brr = Sheets(crr(n)).Range("a3:k" & r)
            For i = 1 To UBound(brr)
                m = m + 1
                arr(m, 1) = m
                arr(m, 2) = crr(n)
                For j = 2 To UBound(brr, 2)
                    arr(m, j + 1) = brr(i, j)
                Next j
            Next i
        Next n
    Sheets("明细汇总").Range("a2").Resize(m, 12) = arr
End Sub

twh14

syj2004hg 发表于 2020-2-17 15:21

大侠，出现错误

twh14

donghui2363 发表于 2020-2-17 17:50
Sub 汇总()
Dim sht As Worksheet
ReDim arr(1 To 10000, 1 To 12)

也出现了错误

twh14

syj2004hg 发表于 2020-2-17 15:21

因为我删除了“明细汇总表”所以出错。感谢感谢！

twh14

donghui2363 发表于 2020-2-17 17:50
Sub 汇总()
Dim sht As Worksheet
ReDim arr(1 To 10000, 1 To 12)

因为我删除了“明细汇总表”所以出错。感谢感谢！

gbgbxgb

试试附件。
成绩单 - 副本.rar (36.11 KB, 下载次数: 7)

2020-2-17 18:59 上传

点击文件名下载附件

twh14

gbgbxgb 发表于 2020-2-17 18:59
试试附件。

可用，感谢！