Question

求 合并多个表格的VBA程序

不同的工作簿下 将多张表格合并
比如
book1:
Name ID Tel E-mail
Zhang 01 13** ****
Li 02 13** ****
book2:
Name ID Tel E-mail
Wang 03 13** ****

只需要简单的合并。不要计算。
Name ID Tel E-mail 这一行出现一次就可以了。
哪位高手给个程序啊~
每张表格首行都是 Name ID Tel E-mail
只是下面的数据不同
现在将多张表格合并成一张表格

Answer 1

不明白再Q我吧，40194204
这个很简单的，以下是Excelhome的一个朋友写的代码：
要求把需要汇总的所有Excel文件放在当前汇总表所在文件夹下的一个叫“分表”的子文件夹中，然后在当前汇总表中依次按ALT+F11、Ctrl+R、回车，把下面的代码粘贴在右边一大片空白的区域后，按F5键，程序就开始汇总文件了，不要动它，等它提示汇总结束点确定，所有数据就汇总到当前汇总表里面了。

Sub temp()
Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer
Application.ScreenUpdating = False '冻结屏幕，以防屏幕抖动
myPath = ThisWorkbook.Path & "\分表\" '把文件路径定义给变量

myFile = Dir(myPath & "*.xls") '依次找寻指定路径中的*.xls文件
Do While myFile <> "" '当指定路径中有文件时进行循环
If myFile <> ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile) '打开符合要求的文件
For i = 1 To AK.Sheets.Count
aRow = AK.Sheets(i).Range("a65536").End(xlUp).Row
tRow = ThisWorkbook.Sheets(1).Range("a65536").End(xlUp).Row + 1

'AK.Sheets(i).Select
AK.Sheets(i).Range("a2:k" & aRow).Copy ThisWorkbook.Sheets(1).Range("a" & tRow)
Next
Workbooks(myFile).Close False '关闭源工作簿,并不作修改
End If
myFile = Dir '找寻下一个*.xls文件
Loop

Application.ScreenUpdating = True '冻结屏幕,此类语句一般成对使用
MsgBox "汇总完成，请查看！", 64, "提示"

End Sub

Answer 2

Sub 合并数据()
Application.ScreenUpdating = False
p = "C:\path\" '文件存放的路径，根据实际修改
f = Dir(p & "*.xls")
Do While f <> ""
r = Workbooks("汇总文件.xls").Sheets(1).[A65536].End(xlUp).Offset(1, 0).Row '假设用以汇总的文件名叫 汇总文件.xls
Workbooks.Open p & f
If r = 2 Then
Sheets(1).UsedRange.Copy Workbooks("汇总文件.xls").Sheets(1).[A1]
Else
Sheets(1).Range([a2], [A65536].End(xlUp).Offset(0, 2)).Copy Workbooks("汇总文件.xls").Sheets(1).Cells(r, 1)
End If
ActiveWorkbook.Saved = True
ActiveWindow.Close
f = Dir
Loop
Application.ScreenUpdating = True
End Sub