如何将多个Excel工作簿合并到一个新的工作表的发法
- 格式:docx
- 大小:13.65 KB
- 文档页数:1
有多个独立的excel工作簿文件需要合并到一个新的工作簿中,保留原来excel工作簿中各个excel工作表名称和结构。如果量小,可以采用打开一个个复制的方法。若有100多份excel 文件要合并到一个excel工作簿,这样就需要用批量处理多个工作簿的合并(PS:不是工作表)。
1、将需要合并的excel工作簿文件放置在一个文件夹中。
2、在该文件夹中,新建立一个新的excel工作簿文件。
3、打开新建立的excel工作簿文件,将鼠标移动到下方工作表名称sheet1上右键,选择查看代码。
4、在弹出的代码编辑窗口中,输入代码。
5、在代码窗口中,粘贴下列代码:
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 =
Num = 0
Do While MyName <>""
If MyName <> AWbName Then
Set Wb = Workbooks.Open(MyPath &"\"& MyName)
Num = Num + 1
With Workbooks(1).ActiveSheet
.Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
For G = 1 To Sheets.Count
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
Next
WbN = WbN & Chr(13) &
Wb.Close False
End With
End If
MyName = Dir
Loop
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "共合并了"& Num &"个工作薄下的全部工作表。如下:"& Chr(13) & WbN, vbInformation, "提示"
End Sub