合并数据，并根据表格名称在最后列填充日期

牛油果绿

如何自动合并多表后在最后一列显示各自表格的出处（根据表格名称显示)


同一个文件夹里面有多个表格，表格的名为（月.日）；例：7.1，  7.2   ，那么请问现在要怎么处理才能把表格数据合并在一个表格并在最后一列显示各自取自哪个表格的数据，求大神指教!

kuangben8

1. Sub 汇总()
   
2.     Dim Pth As String, Wname As String
   
3.     Dim k%, m&, arr
   
4.     Dim Wbook As Workbook, Sht As Worksheet
   
5.     Application.ScreenUpdating = False
   
6.     Pth = ThisWorkbook.Path & Chr(92)
   
7.     Wname = Dir(Pth & "*.xls*")
   
8.     ActiveSheet.Cells.Clear
   
9.     Do While Wname <> ""
   
10.         If Wname <> ThisWorkbook.Name Then
    
11.             k = k + 1
    
12.             Set Wbook = GetObject(Pth & Wname)
    
13.             Set Sht = Wbook.Worksheets("sheet1")
    
14.             If k = 1 Then
    
15.                 arr = Sht.Range("A1").CurrentRegion
    
16.             Else
    
17.                 arr = Sht.Range("A1").CurrentRegion.Offset(1)
    
18.             End If
    
19.             With ActiveSheet
    
20.                 m = IIf(k = 1, 1, .Range("A1").End(xlDown).Row + 1)
    
21.                 .Range("A" & m).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    
22.                 .Cells(1, UBound(arr, 2) + 1) = "工作簿名称"
    
23.                 .Cells(IIf(m = 1, 2, m), UBound(arr, 2) + 1).Resize(UBound(arr, 1) - 1) = Wname
    
24.             End With
    
25.             Wbook.Close False
    
26.         End If
    
27.         Wname = Dir
    
28.     Loop
    
29.     Application.ScreenUpdating = True
    
30. End Sub

复制代码

kuangben8

代码审核中。
数据合并并填充日期.zip (54.85 KB, 下载次数: 2)

2021-8-3 11:34 上传

点击文件名下载附件

牛油果绿

kuangben8 发表于 2021-8-3 11:34

非常感谢大神，已经可以了 ，加入的那列没办法按照大小来排序，我重新更改了下表格的名称，