作者：乔山办公网日期：
返回目录：excel表格制作
将需合并的excel文件放在同一个文件夹中，并这个文件中新建一个excel文件
如何将多个excel文件合并为一个excel
打开新建的excel文件，按alt + f11建，打开宏，选择视图——代码窗口
如何将多个excel文件合并为一个excel
如何将多个excel文件合并为一个excel
将下面分割线内的的代码拷贝进去，并保存。
======我是分割线======
Sub sheets2one()
'定义对话框7a686964616fe4b893e5b19e330变量
Dim cc As FileDialog
Set cc = Application.FileDialog(msoFileDialogFilePicker)
Dim newwork As Workbook
Set newwork = Workbooks.Add
With cc
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:=newwork.Worksheets(i)
newwork.Worksheets(i).Name = VBA.Replace(tempwb.Name, ".xls", "")
tempwb.Close SaveChanges:=False
i = i + 1
Next vrtSelectedItem
End If
End With
Set cc = Nothing
End Sub
======我是分割线======
如何将多个excel文件合并为一个excel
点击运行，弹出对话框可，点击运行选项运行程序，
如何将多个excel文件合并为一个excel
如何将多个excel文件合并为一个excel
再次弹出选择对话框，选择要批量合并的excel名，确定即可
如何将多个excel文件合并为一个excel
程序运行完毕后，会自动生成一个工作簿，工作簿内包含所有需合并的excel文件，将工作簿另外即可
如何将多个excel文件合并为一个excel
如何将多个excel文件合并为一个excel
1、假设3月1日至3月10日的数据需要百合并和汇总，并打开计算机数据面板。
2、创度建一个新的空白文件夹，并将合并的表知单放在该文件夹中。
3、创建新的空白excel表单。
4、单击excel表单中的数据道->合并表单->将多个工作表合并到一个工作表中。
5、单击添加文件添加要合并的excel数据表。
6、完成上一步后，取消选中新创建的excel表格，单击左下角的选项，选择表格标题中的行数为1，然后单击开回始合并。
7、完成后，两个工作簿将出现在新的excel表中，一个是合答并报表，显示数据合并是否成功，另一个是合并工作簿。
把 多个工作表 合并到到一张表zd， 最快捷的方法是用宏处理：
例如 将多个表合并到总计表：
总计 表只留一个标题
右键点 汇总 工作表回 标签 ，查看代码， 把如下代码复制进去， F5运行:
Sub 工作表合并()For Each st In WorksheetsIf st.Name <> ActiveSheet.Name Then st.UsedRange.Offset(1, 0).Copy [a65536].End(xlUp).Offset(1, 0)NextEnd Sub
就会把多个表合并 到 总表，
如下例： 在Sheet 总计 中 运行 如上代码，就会将所有 月份 分表 汇总 进来，方便后续处理答，而 不需要一次次粘贴处理
第一把这些表放在一个新建立 的文件夹里，
第二在这个新建立 的文件夹里再新建一个excel表格文件
打开这个文件 在左下角sheet1标签处右键 查看代码7a686964616fe4b893e5b19e365 然后把下面代码 复制进去 然后点运行 运行子过程
等几不一会时间就可以了，你的表格没有合并过和单元格才行，如果 有这个程序也会中断的，还有确定每个表的A列得有内容
等待合并完以后把B列有空的行用筛选的方式删除了就行
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