合并多个Excel表至Sheet表，请修改！

ppdye

Sub 合并当前目录下所有工作簿的全部工作表()
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim G As Long
Dim Num As Long
Dim BOX As String
Application.ScreenUpdating = False
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.xls")
AWbName = ActiveWorkbook.Name
Num = 0
Do While MyName <> ""
If MyName <> AWbName Then
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
Num = Num + 1
With Workbooks(1).ActiveSheet
.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
For G = 1 To Sheets.Count
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
Next
WbN = WbN & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName = Dir
Loop
Range("B1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub

说明，上面的代码从网上找的，可用，用于将多个当前文件夹内所有EXCEl的所有SHEET表复制在一个SHEET里！
我就想改一下条件，但运行代码是弹出选择框，进将选择的EXCEl 表中的SHEET合并在一张SHEET 表，而不是当前文件夹的全部EXCEl表
改成可以选择表单样式的如图：

lxlyhu

几十上百个工作薄、几百上千个工作表，要汇总，怎么办？复制、粘贴……要搞死人！！！   多薄多表合并：一键帮你搞定！！！

lxlyhu

多薄多表合并——excel外接程序插件（安装程序）
多薄合并：可将某一文件夹下的所有工作薄（可含不同工作表）合并到一个工作薄对应的工作表中。
多表合并：可将当前工作薄中的所有工作表合并到一个自动新建的且位于最前面的“汇总表”工作表中。
清除数据：可清除当前工作表或当前工作薄中所有工作表中的数据（表头除外）。

lxlyhu

多薄多表合并，建议安装在C盘以外（如：D盘），防止恢复系统导致误删。
安装完成后，在excel2003工具栏或excel2010加载项——3个功能按钮：多薄合并、多表合并、清除数据。

lxlyhu

多薄合并：默认合并当前工作薄所在文件夹下的所有工作薄，合并完成后自动新建一个“汇总表”工作薄，且保存在当前文件夹下；在新建工作薄中自动打开“文件夹选择对话框”供用户选择要合并的文件夹。

lxlyhu

ppdye

lxlyhu 发表于 2014-4-16 08:02
几十上百个工作薄、几百上千个工作表，要汇总，怎么办？复制、粘贴……要搞死人！！！   多薄多表合并：一键 ...

谢谢你，貌似不能安装

lxlyhu

你的电脑肯定进行了——多用户设置！！！
进行了——多用户设置，必须具有“系统管理员”身份才能注册安装

lxlyhu

多薄多表合并——已经更新，并做成了安装文件，只需双击setup.exe即可安装，不再需手工注册！！！

lxlyhu

你是通过手工注册mergebooks.dll方式的，必须具备“系统管理员“身份，才能注册安装！！
更新后的”多薄多表合并”，已经做成了安装软件，（先前的mergebooks.dll可以删除不要了）只需双击setup.exe即可完成安装！！！