根据多个工作簿中工作表名合并到汇总工作簿中对应工作表

除非注明，文章均为战战如疯原创，转载请保留链接: http://www.zhanzhanrufeng.com/cat4/359.html，VBA交流群273624828。

今天再来看一个多工作簿汇总的例子，是在excelhome上看到的一个求助帖子，原帖要求如下：

根据多个工作簿内工作表名称合并到汇总工作簿对应的工作表中
1、汇总表格式包含3个工作表,分别是《行政机构人员信息》+《事业单位人员信息》+《数据输入说明》，
2、明细表则为《事业单位人员信息》+《数据输入说明》，或者《行政机构人员信息》+《数据输入说明》，
3、需要将明细表目录下的工作簿，按工作表名称，分别合并到汇总表中的工作表中。
4、即打开工作簿，如果包含《行政机构人员信息》工作表，则合并到汇总表《行政机构人员信息》中；如果包含《事业单位人员信息》，则合并到汇总表《事业单位人员信息》中。

这个例子与之前“多个Excel工作簿中的内容汇总到一个Excel表中”的区别在于这个例子中不知道要汇总的工作簿中到底存在哪几个表，这样的话就需要我们在汇总之前先判断某个工作表是否存在。判断某个工作表是否存在思路很多，可以循环判断某个工作表是否存在，也可以通过返回的错误值来判断，例如下面代码可以判断工作簿中是否存在名为“工作表1”的工作表。

Sub 判断工作表是否存在()
On Error Resume Next
If Sheets("工作表1") Is Nothing Then
MsgBox "工作表不存在"
Else
MsgBox "工作表存在"
End If
End Sub

不存在的话Sheets("工作表1")会提示错误，在On Error Resume Next语句配合下也就是返回Nothing。

下面来看完整的代码

Sub 汇总()
Dim wb, mypath, myfile
Sheets("行政机构人员信息").UsedRange.Offset(1, 0).ClearContents
Sheets("事业单位人员信息").UsedRange.Offset(1, 0).ClearContents
mypath = ThisWorkbook.Path & "\明细表\"
myfile = Dir(mypath & "*.xls")
Do While myfile <> ""
Set wb = GetObject(mypath & myfile)
On Error Resume Next
With wb.Sheets("行政机构人员信息")
.Rows("3:" & .[a65536].End(xlUp).Row).Copy Sheets("行政机构人员信息").Rows(Sheets("行政机构人员信息").[a65536].End(xlUp).Row + 1)
End With
On Error Resume Next
With wb.Sheets("事业单位人员信息")
.Rows("3:" & .[a65536].End(xlUp).Row).Copy Sheets("事业单位人员信息").Rows(Sheets("事业单位人员信息").[a65536].End(xlUp).Row + 1)
End With
myfile = Dir
Loop
Set wb = Nothing
End Sub

先是遍历文件夹“明细表”里的每个工作簿，在工作簿中又要依次判断是否存在“行政机构人员信息”和“事业单位人员信息”这两个表，存在的外就执行下面的复制语句，不存在的话返回错误，在On Error Resume Next的配合下就直接跳过了该步，正好实现了我们的目的。

本节示例文件下载：http://pan.baidu.com/s/1o6MB8aI。