1、新建一个文件夹。 2、将要合并的表格放到里面
3、新建一个表格,用excel打开,右击Sheet1选择查看代码。 4、将下列代码复制到文本框中,点击运行,即可成功合并
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文件合并到一个excel的多个sheet
1、新建一个文件夹,将需要合并的excel文档复制到该文档目录下。
2、新建一个EXCEL空白文档,鼠标移动到在sheet工作表上单击右键,选择“查看代码”选项,进入VBA控制台。在菜单栏点击“插入”菜单,选择“模块”选项,进入模块编辑界面。在编辑框中复制以下代码(黑色字体部分),注意符号,需是英文状态下。
3、代码输入后,点击菜单项中“运行”,选择“运行子过程”选项,或者按下F5快捷键,运行代码。
4、运行代码后,会弹出文档选择界面,找到新建文件夹的路径,选择你所需要合并的文档,选择文档后,点击“打开”,代码正在运行,运行时间视文档数目而定。
5、代码段运行结束后,就会出现已经合并完成的excel文档界面,新工作表的名称等于原工作簿的名称,大功告成!
'功能:把多个excel工作簿的第一个sheet工作表合并到一个excel工作簿的多个sheet工作表,新工作表的名称等于原工作簿的名称 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
newwb.Worksheets(i).Name = VBA.Replace(tempwb.Name, \".xls\'关闭被合并工作簿
tempwb.Close SaveChanges:=False i = i + 1
Next vrtSelectedItem End If End With
Set fd = Nothing End Sub
因篇幅问题不能全部显示,请点此查看更多更全内容