求宏代码：汇总不同excel文件到一个文件里

Question

问题描述：
1、在同一文件夹里，有若干个只有一张sheet的excel文件，所以sheet的字段均一样，但这些sheet名称不一样。比如，有张三、李四、王五 3个excel文件中，张三文件里有一张叫shee1的工作表，李四文件里有一张叫sheet8的工作表，王五文件里有一张叫sheet10的工作表，这些工作表表样完全一样。
2、现在需要将这些excel文件的sheet，汇总到一个新的excel文件里sheet1中，且汇总后的excel表最后一列字段根据汇总数据源文件名进行区分，比如张三、李四、王五的表都是从A列至G列，那么完成的汇总表在H列会自动列名数据是粘贴自哪个文件名。

感谢excel大神赐教！

Answer 1

将要合并的文件放在一个文件夹中，本人提供一段代码，可以将选定的文件拷贝到一个指定文件中，可以大大减轻您的负担。希望能帮到您。

新建个excel，添加个按钮，将代码复制进去，会将每个工作簿的第一张表格复制到一个新文件里保存。

Sub 合并所选工作簿的第一张工作表()
Dim filefullname, temp_work As Workbook, temp_sheet, tag_work
Dim x
Dim nb_sheet, name
ChDrive Left(ThisWorkbook.Path, 1)
ChDir ThisWorkbook.Path
Do
filefullname = Application.GetOpenFilename("Excel文件,*.xlsx,Excel文件,*.xls", 1, MultiSelect:=True)
If TypeName(filefullname) = "Boolean" Then
If MsgBox("未打开文件，是否重试?", vbRetryCancel, "汇总程序") <> vbRetry Then
MsgBox "未选定，退出程序。", vbInformation, "汇总程序"
End
End If
End If
Loop Until TypeName(filefullname) <> "Boolean"
Set tag_work = Application.Workbooks.Add
Application.ScreenUpdating = False
For x = 1 To UBound(filefullname)
Set temp_work = Workbooks.Open(Filename:=filefullname(x), UpdateLinks:=False)
temp_work.Sheets(1).Copy before:=tag_work.Sheets(1)
name = Split(Dir(filefullname(x)), ".")
Sheets(1).name = name(0)
temp_work.Close False
Next x
tag_work.SaveAs ThisWorkbook.Path & "\" & InputBox("请输入要保存的文件名称") & ".xlsx"
tag_work.Close
Application.ScreenUpdating = True
end sub

祝您一切顺利。（注意：选的文件可以是xls，xlsx文件，保存为xlsx文件）

追问

您好！您的回答似乎不是我想要的结果，但还是非常感谢您的热情帮助，祝您及家人身体健康平安，事业步步高、财源滚滚来！：）

Answer 2

有奖励可以帮你写