excel合并同一目录下代码（多文件合并到同一个文件多Sheet下、多文件合并到同一个Sheet下）

一、多文件合并到同一个文件多Sheet下：
1、在想要合并的excel文件目录中新建一个excel文件。
2、右键新建excel中的sheet1选择“查看代码”，或者Alt+F11直接调出VBA操作界面。
3、运行以下代码（蓝色加粗倾斜字体为代码）。

注意：
1、excel文件类型是xls和xlsx，需要对应修改代码里的后缀
2、合并前最好关闭其他excel文件，否则可能出现合并数据插入到其他excel的情况。
3、该代码不支持被合并的excel多sheet情况，只会把第一个sheet合并到结果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

二、多文件合并到同一个Sheet下：
1、在想要合并的excel文件目录中新建一个excel文件。
2、右键新建excel中的sheet1选择“查看代码”，或者Alt+F11直接调出VBA操作界面。
3、运行以下代码（蓝色加粗倾斜字体）。

注意：
1、excel文件类型是xls和xlsx，需要对应修改代码里的后缀
2、合并前最好关闭其他excel文件，否则可能出现合并数据插入到其他excel的情况。

代买如下：

 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