怎么把多个数据表合并到一个表并自动更新

BigGoodMan

求助，怎么把多个数据表合并到一个总表，分表内容有变化后，总表内容能自动更新，能保持原来格式最好。表头一样，只是从第四行数据不同。参照网上的代码，折腾2小时，做不出那个效果，求解，万分感谢！！！

洋务德雷

能不用vba就不要用vba。除非你自己会编辑vba。
这个问题用SQL解决再简单不过了。

BigGoodMan

洋务德雷 发表于 2021-11-5 20:24
能不用vba就不要用vba。除非你自己会编辑vba。
这个问题用SQL解决再简单不过了。

多谢解答，都是高人

一帆风顺2020

1. Sub tst()
   
2.     Dim i&, ph$, st$
   
3.     Dim wr As Workbook
   
4.     ph = ThisWorkbook.Path & ""
   
5.     st = Dir(ph & "*.xls*")
   
6.     With Sheet1
   
7.         .Range("a4").Resize(.UsedRange.Rows.Count, 1).EntireRow.Delete
   
8.     End With
   
9.     Application.ScreenUpdating = False
   
10.     Application.DisplayAlerts = False
    
11.     Do While st <> ""
    
12.         If st <> ThisWorkbook.Name Then
    
13.             Set wr = Workbooks.Open(ph & st)
    
14.             With wr.Sheets(1)
    
15.                 .AutoFilterMode = False
    
16.                 i = .Cells(.Cells.Rows.Count, 2).End(3).Row
    
17.                 If i > 3 And .Cells(2, 2) = "上报时间" Then
    
18.                     .Cells(4, 1).Resize(i - 3, 1).EntireRow.Copy
    
19.                     With ThisWorkbook.Sheets(1)
    
20.                         i = .Cells(.Cells.Rows.Count, 2).End(3).Row
    
21.                         If i < 4 Then i = 4 Else i = i + 1
    
22.                         .Cells(i, 1).PasteSpecial
    
23.                     End With
    
24.                 End If
    
25.             End With
    
26.             Application.CutCopyMode = False
    
27.             wr.Close (False)
    
28.             Set wr = Nothing
    
29.         End If
    
30.         st = Dir()
    
31.     Loop
    
32.    
    
33.    
    
34.     With Sheet1
    
35.         i = .Cells(.Cells.Rows.Count, 2).End(3).Row
    
36.         If i > 4 Then
    
37.             .Cells(4, 1).Resize(i - 3, 20).Sort .Cells(1, 2), xlAscending, , , , , , xlNo
    
38.             ReDim brr(1 To i - 3, 1 To 1)
    
39.             For i = 1 To UBound(brr)
    
40.                 brr(i, 1) = i
    
41.             Next i
    
42.             .Cells(4, 1).Resize(UBound(brr), 1) = brr
    
43.         End If
    
44.     End With
    
45.     Call hz
    
46.     Application.ScreenUpdating = True
    
47.     Application.DisplayAlerts = True
    
48.     MsgBox "完成"
    
49. End Sub

复制代码