向VBA大神求助，多张表汇总！
简单地说我有5张excel表每张表字段都相同，例如：编号，名称，规格 。

现在我想把这五张表内容汇总成一张表，第一张表下面接第二张表的数据，之后是第三张，一次类推。

每次对五张表中的一张增加或者修改，合成的那张表就会自动从新生成。

耽误大侠几分钟时间，帮我写个VBA宏，带上注释，给个框架或者关键函数，给思路都行。 vba excel 合成表
[解决办法]
有两种方法
一是直接用SQL查询的汇总
二是用VBA打开文件，复制粘贴到一张表后用透视表

其实你还不如把5个表都放到一个工作簿里得了，然后用数据透视表的合并计算
[解决办法]
只是简单的把五张表的内容叠加式的复制到一张表中吗？还是需要进行汇总呢？
如果只是进行叠加式的复制的话我倒是有一个现成的VBA。

这个是针对文件进行操作的，只要指定了文件名以及相应的表就可以进行合并。
Option Explicit

Sub adddate() '该VBA是打开相应的数据并将相应的表头COPY到相应的文件名称后面。
Dim Filename As String
Dim rownum As Integer
Dim totalrow As Integer
Dim buildtype As String
Dim totalclum
Dim j, i
Dim needrow
Dim btsprice, bscprice, sheetcount, sheetname
'Dim biaoti, shuliang As Range

Application.DisplayAlerts = False
Application.ScreenUpdating = False

totalrow = 0
buildtype = ""
btsprice = 0
bscprice = 0
'Set biaoti = Nothing
'Set shuliang = Nothing

Windows("test.xlsm").Activate
Sheets(1).Activate

rownum = Sheet1.Range("a1").End(xlDown).Row

For i = 1 To rownum
Filename = Cells(i, 1).Value

Workbooks.Open Filename
sheetcount = Sheets.Count
For j = 1 To sheetcount
sheetname = Trim(Sheets(j).Name)

If Trim(Sheets(j).Name) = "BTSINFO" Then 'btsprice = 1

Sheets("BTSINFO").Activate
Cells.EntireColumn.Hidden = False


totalrow = ActiveSheet.Range("e65535").End(xlUp).Row

totalclum = ActiveSheet.Range("fc1").End(xlToLeft).Column

'Debug.Print totalrow, totalclum

' ActiveSheet.Range(Cells(1, 5).Address, Cells(1, totalclum).Address)
'shuliang = ActiveSheet.Range(Cells(totalrow, 5).Address, Cells(totalrow, totalclum).Address)

'Application.Union(Range(Cells(1, 3).Address, Cells(1, totalclum).Address), Range(Cells(totalrow, 3).Address, Cells(totalrow, totalclum).Address)).Select

Range(Cells(2, 1).Address, Cells(totalrow, 6).Address).Select
Selection.Copy


Windows("test.xlsm").Activate
Sheets(2).Activate
needrow = ActiveSheet.Range("a65535").End(xlUp).Row + 1 '这样可保留总计项。
' Debug.Print needrow
Cells(needrow, 1) = Filename
Cells(needrow + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False '按值粘贴
'Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True '按转置粘贴
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True '按值粘贴并转置
totalrow = 0
totalclum = 0
needrow = 0
btsprice = 0
bscprice = 0
ActiveWindow.ActivateNext

End If
Next j
ActiveWindow.Close

Windows("test.xlsm").Activate
Sheets(1).Activate

Next i


Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

[解决办法]
怎么我都没有编辑自己帖子的权限
判断更新运行宏示例
Private Sub Worksheet_Change(ByVal Target As Range)
adddate
End Sub
假设三楼的宏就是你要的