返回信息流弱弱的问一下，怎样把两个表合并到一起，格式都一样，只是不同的人做不同序号然后交上来的，怎样把它们合成一个表~
谢谢咯~
这是一条镜像帖。来源：北邮人论坛 / office-tool / #27840同步于 2010/4/8
该镜像源已超过 30 天没有更新，可能在源站已被删除。
OfficeTool机器人发帖
关于excel两个表的合并
flyingcheng
2010/4/8镜像同步4 回复
订阅后，新回复会通过你的通知中心匿名送达。
4 条回复
请测试
Sub D13输入合并多个工作表包括表头()
Application.ScreenUpdating = False
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim newwb As Workbook
Set newwb = Workbooks.Add
newwb.Application.ActiveWindow.Caption = "NEWBOOK.xls"
With fd
.Title = " 请选择要合并的工作本 "
If .Show = False Then
newwb.Close savechanges:=False
Exit Sub
End If
xx: Dim dInput As String
dInput = Application.InputBox(Prompt:="请直接输入要合并的sheet名，请确保各个book的对应的Sheets名一致")
If dInput = "False" Then
newwb.Close savechanges:=False
Exit Sub
End If
Dim vrtSelectedItem As Variant
Dim tempwb As Workbook
k = 1
For Each vrtSelectedItem In .SelectedItems
Set tempwb = Workbooks.Open(vrtSelectedItem)
On Error Resume Next
Set mySheet = Sheets(dInput)
If Err.Number <> 0 Then
MsgBox " 工作表不存在! 请重新输入正确的Sheet名! "
'newwb.Close SaveChanges:=False
Application.CutCopyMode = False
tempwb.Close savechanges:=False
GoTo xx:
End If
If k = 1 Then
Sheets(dInput).Select
i = ActiveSheet.UsedRange.Rows.Count
Rows("1:" & i).Select
Selection.Copy
Windows("newbook.xls").Activate
j = ActiveSheet.UsedRange.Rows.Count
Cells(1, 1).Select
ActiveSheet.Paste
End If
If k > 1 Then
Sheets(dInput).Select
i = ActiveSheet.UsedRange.Rows.Count
Rows("1:" & i).Select
Selection.Copy
Windows("newbook.xls").Activate
j = ActiveSheet.UsedRange.Rows.Count
Cells(j + 1, 1).Select
ActiveSheet.Paste
End If
Application.CutCopyMode = False
tempwb.Close savechanges:=False
k = k + 1
Next vrtSelectedItem
End With
Set fd = Nothing
Application.ScreenUpdating = True
End Sub
阿门。。。
【 在 fxw (木婉清) 的大作中提到: 】
: 请测试
: Sub D13输入合并多个工作表包括表头()
: Application.ScreenUpdating = False
: ...................