科普：xls格式最多就65535行，xlsx格式最多是1048576行。
 
有时候办公室同事从系统上导出表，当数据量过大的时候，系统都会拆分成多个sheet来导出，每个sheet的表结构一致。
 他们需要将sheet合并，这样以便做筛选，做透视表。
 
这里帮他们搞了个xlsm小工具，直接将一个工作簿中的多个sheet合并为1个。
 
小工具界面
 
打开文件，里边有操作表sheet以及结果表sheet。操作表是选择文件，或者填写一些合并的一些参数。
 合并后的数据，显示在结果表sheet中。
 
当时他给我看的工作簿，有40+个sheet，每个sheet有6.5w行，总数就是266.5w条数据，由于单个sheet最多只能是104w条，只能建议他合并为3个sheet，再分别做透视表了。
 
sheet起点、终点，是指需要从第几个sheet作为起点，一路合并到终点sheet，这里填的是整数值，也可以不填。
 
 
造测试工作簿
 
新建了一个工作簿，里边两个sheet，数据内容如下图所示。
 
 
 
使用步骤
 
打开小工具，点击按钮，可以选择文件。我们选择刚刚造的工作簿。然后后台就开始合并了。
 
 
合并结束时，界面会弹框提示，左侧也会罗列一下相关信息。
 
 合并的结果在结果表sheet中。
 
 
vba代码
 
Private Sub CommandButton1_Click()
Dim k
Dim start_pos As Integer
Dim end_pos As Integer


'清空sheet
Sheets("结果表").Range("A:ZZ").Clear
'选择文件
Dim filePath As String
filePath = getFile()
If filePath = "" Then Exit Sub

'获取参数
start_pos = ThisWorkbook.Sheets("操作表").Range("B7")
end_pos = ThisWorkbook.Sheets("操作表").Range("B8")
If start_pos > end_pos Then
    MsgBox ("起点比终点大？请检查。")
    Exit Sub
End If

'打开目标文件
Set k = Workbooks.Open(filePath)
Dim totalSheet As Integer
totalSheet = k.Sheets.Count


If start_pos <= 0 Then
    start_pos = 1
ElseIf start_pos > totalSheet Then
    start_pos = totalSheet
End If

If end_pos = 0 Then
    end_pos = totalSheet
ElseIf end_pos > totalSheet Then
    end_pos = totalSheet
End If

'遍历要合并sheet的工作簿
Dim cnt As Integer
cnt = 1
For Each sh In k.Sheets
    If cnt >= start_pos And cnt <= end_pos Then
        行 = ThisWorkbook.Sheets("结果表").Range("A1040000").End(xlUp).Row + 1
        sh.UsedRange.Copy ThisWorkbook.Sheets("结果表").Range("A" & 行)
    End If
    cnt = cnt + 1
Next
 
'关闭目标文件
k.Close SaveChanges:=False

'输出数据
ThisWorkbook.Sheets("操作表").Range("A5") = "文件名："
ThisWorkbook.Sheets("操作表").Range("A6") = "sheet总数："
ThisWorkbook.Sheets("操作表").Range("A7") = "sheet起点："
ThisWorkbook.Sheets("操作表").Range("A8") = "sheet终点："

ThisWorkbook.Sheets("操作表").Range("B5") = filePath
ThisWorkbook.Sheets("操作表").Range("B6") = totalSheet
ThisWorkbook.Sheets("操作表").Range("B7") = start_pos
ThisWorkbook.Sheets("操作表").Range("B8") = end_pos

MsgBox ("已生成，请检查，已复制文件" & filePath & "的第" & start_pos & "个至第" & end_pos & "个sheet")

End Sub


Function getFile()
'获取文件完整路径及文件名

'显示打开文件夹对话框
Set FileDialogObj = Application.FileDialog(msoFileDialogFilePicker)
With FileDialogObj
    .Title = "请选择文件"
    .AllowMultiSelect = False
End With

'选择文件
FileDialogObj.Show
If FileDialogObj.SelectedItems.Count > 0 Then
    getFile = FileDialogObj.SelectedItems(1)
Else
    getFile = ""
    MsgBox ("未选择文件")
End If

End Function



 
文件下载
 
xlsm下载链接

 
打开一空白xls，按Alt+F11 进入宏编辑界面—> 插入模块，在右边粘贴上如下代码，按F5 即可运行。
 
'功能：把多个工作簿的第一个工作表合并到一个工作簿的多个工作表，新工作表的名称等于原工作簿的名称
 
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 As Variant
 
'定义循环变量
 
Dim i As Integer
 
i = 1
 
'开始文件检索
 
For Each vrtSelectedItem In .SelectedItems
 
'打开被合并工作簿
 
Dim tempwb As Workbook
 
Set tempwb = Workbooks.Open(vrtSelectedItem)
 
'复制工作表
 
tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i)
 
'把新工作簿的工作表名字改成被复制工作簿文件名，这儿应用于xls文件，即Excel97-2003的文件，如果是Excel2007，需要改成xlsx

对于不熟悉Excel公式，不熟悉vba的人，要如何按需要快速把多个excel表合并成一个excel表？
 
    对于Excel的合并，很多需要通过vba变成，但对于不熟悉vba编程的人，如何合并呢？给大家推荐一个  一键解决excel表合并的问题的工具，不在需要使用Excel公式或者vba。
 
   工具地址：www.excelfb.com
 
    最新工具支持插入 文件名、sheet名列，请到网站看工具界面，无需安装，直接网页在线使用
 
需求一、 所有表格式都一样，我要合并到一个表。
 
     例如我们有如下多个Excel文件或者多个Sheet，点击 ：批量合并   中的  多个Excel文件多个Sheet合并（合并到一个Sheet）
 
    
 
操作方式如下：
 
     
 
需求二、 所有表格式都一样，去表头合并到一个表。
 
     我们发现不需要表头，好了还是上面的工具, 批量合并   中的  多个Excel文件多个Sheet合并（合并到一个Sheet），
 
    填入从表的第2行开始合并，合并结果如下：
 
    
 
 
 
     需求三、 需要将相同Sheet名的合并到一个，因为要分类合并或者格式不一样。
 
点击   批量合并   中的  多个Excel文件合并（相同名称的Sheet表合并）
 
操作跟需求一、需求二一样，看结果如下：
 
 
       

合并sheet页, 合并excel文档, 合并工作表, 合并工作簿
 
合并工作表(sheet)
 
合并多个工作表 
 仅适用于每个sheet的第一行是数据头，数据从第二行开始。
 
Sub 合并工作表()
    Dim J As Integer
    On Error Resume Next
    Sheets(1).Select
    Worksheets.Add
    Sheets(1).Name = "Combined"
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")
    For J = 2 To Sheets.Count
        Sheets(J).Activate
        c = Sheets(J).Range("IV1").End(xlToLeft).Column
        r = Sheets(J).Range("A65536").End(xlUp).Row
        Range("A2").Resize(r - 1, c).Select
        Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
    Next
End Sub
 
合并工作簿
 

Sub 合并工作簿()

    Dim FileOpen
    Dim X As Integer
    Application.ScreenUpdating = False
    FileOpen = Application.GetOpenFilename(FileFilter:="Excel 97-2003 工作簿(*.xls),*xls,Microsoft Excel文件(*.xlsx),*.xlsx", MultiSelect:=True, Title:="请选择需要合并的工作簿")
    X = 1
    If TypeName(FileOpen) = "Boolean" Then
        MsgBox "未选择任何文件, 退出."
        Exit Sub
    End If

    While X <= UBound(FileOpen)
        Workbooks.Open Filename:=FileOpen(X)
        Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        X = X + 1
    Wend
ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

errhadler:
    MsgBox Err.Description
End Sub