多个工作簿、多个工作表合并
我的第2版Excel新书《Excel职场手册：260招菜鸟变达人》5月10日出版啦，比第1版增加了很多内容，操作动画和视频共100个，定价不变，非常超值。
示例文件、操作动画和视频也可以到我的微云上下载，链接地址 http://url.cn/51t8vU7
购书网址：
京东网：http://item.jd.com/12072001.html
当当网：http://product.dangdang.com/25073253.html
亚马逊：https://www.amazon.cn/dp/B0711DZB44
人民邮电出版社异步社区 ：http://www.epubit.com.cn/book/details/4766
天猫：https://detail.tmall.com/item.htm?
spm=a220m.1000858.1000725.171.10JReA&id=550004809791&user_id=2049420857&cat_id=2&is_b=1&rn=64312a65425de0826a7ab9b7af05f609
今日分享如下（建议收藏）：
工作簿是处理和存储数据的文件，每个工作簿可以包含多张工作表。今天给大家分享多个工作簿合并到一个工作簿多张工作表、多个工作簿合并到一个工作簿一张工作表、多个工作表合并到一个工作表批量合并方法。
一、多个工作簿合并到一个工作簿多张工作表
工作中有时需要将多个工作簿中数据（每个工作簿只有一张工作表）合并到一个工作簿中，方便统计和保存，保留原来Excel工作簿中的名称和结构。如果量少，只有少数几个文件，可以打开一个个复制，若有几十个甚至上百个Excel文件要合并到一个工作簿中，就需要批量处理多个工作簿的合并。步骤如下：
Step1、将需要合并的Excel工作簿放在一个文件夹中；
Step2、在该文件夹中新建一个工作簿；
Step3、打开新建立的Excel工作簿，按下Alt+F11组合键，在Visual Basic编辑器中选择“插入→模块”，在代码窗口输入以下代码，点击菜单栏运行，运行子过程/用户窗体，弹出需要合并的文件，关闭代码输入窗口。打开Excel工作簿，可以看到将选中的工作簿中的工作表都复制到了新建工作簿中。
Sub Books2Sheets()
'定义对话框变量
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'新建一个工作簿
Dim newwb As Workbook
Set newwb = Workbooks.Add
With fd
If .Show = -1 Then
'定义单个文件变量
Dim vrtSelectedItem AsVariant
'定义循环变量
Dim i As Integer
i = 1
'开始文件检索
For Each vrtSelectedItemIn .SelectedItems
'打开被合并工作簿
Dim tempwb AsWorkbook
Set tempwb =Workbooks.Open(vrtSelectedItem)
'复制工作表
tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i)
'把新工作簿的工作表名字改成被复制工作簿文件名，这儿应用于xls文件，即Excel97-2003的文件，如果是Excel2007，需要改成xlsx
newwb.Worksheets(i).Name = VBA.Replace(tempwb.Name, ".xls","")
'关闭被合并工作簿
tempwb.CloseSaveChanges:=False
i = i + 1
Next vrtSelectedItem
End If
End With
Set fd = Nothing
End Sub
二、多个工作簿合并到一个工作簿一张工作表
工作中有时候需要把多个工作簿合并到一个工作簿的一张工作表，操作步骤如上节内容一样，只需把代码修改如下：
Sub 合并汇总()
Application.DisplayAlerts= False
Application.ScreenUpdating= False
FileToOpen_N =Application.GetOpenFilename("xlsx文件,*.xlsx", _
Title:="请选择要合并工作簿", MultiSelect:=True)
Newbz = 0
On Error ResumeNext
For EachFileToOpen In FileToOpen_N
If FileToOpen<> False Then
If Newbz = 0 Then
Booknum =Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook= 1
Workbooks.Add
Application.SheetsInNewWorkbook= Booknum
NewBookName =ActiveWorkbook.Name
Sheets(1).Name ="sheet_tmp"
Newbz = 1
End If
Set OpenBook =Workbooks.Open(FileToOpen)
For Each XlsheetIn OpenBook.Sheets
Xlsheet.CopyBefore:=Workbooks(NewBookName).Sheets("sheet_tmp")
Next
OpenBook.CloseSaveChanges:=False
End If
Next
Workbooks(NewBookName).Sheets("sheet_tmp").Delete
Application.ScreenUpdating= True
Application.DisplayAlerts= True
Dim sht AsWorksheet, lstRowZb As Integer, lstRow As Integer
'lstRowZb:总表的lastrow
Worksheets("1").Select
Worksheets("1").Range("a1:h1").CopyDestination:=Range("a1")
'复制表头
For Each sht InWorksheets
lstRowZb =Range("a1048576").End(xlUp).Row '每次COPY前取总表的最后一行
With sht
If .Name <>"1" Then
lstRow =.Range("a1048576").End(xlUp).Row
.Range("a2:h"& lstRow).Copy Destination:=Cells(lstRowZb + 1, "a")
End If
End With
Next sht
End Sub
三、多个工作表合并到一张工作表
打开汇总表，点击开发工具→查看代码，输入以下代码：
Option Explicit
Sub Test() '多工作表合并
Dim Ws As Worksheet, k%, SumWs AsWorksheet, 最后&
Set SumWs = Sheets("总表")
For Each Ws In Sheets
If Ws.Name <> "总表" Then
k = k + 1
If k = 1 Then
'复制表头
Ws.Range("A1").CurrentRegion.Copy SumWs.[A1]
Else
'不复制表头
最后 = SumWs.Cells(Rows.Count, 1).End(xlUp).Row + 1
Ws.Range("A1").CurrentRegion.Offset(1, 0).Copy SumWs.Cells(最后, 1)
End If
End If
Next Ws
End Sub