1

'收集各个excel文件的首个sheet，并组成包含这些sheet的新excel文件
Sub 合并()
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ThisWorkbook.Path
If .Show Then
fDir = .SelectedItems(1) & ""
Else
Application.ScreenUpdating = True
Exit Sub
End If
End With
fName = Dir(fDir)
Do Until fName = ""
fPath = fDir & fName
Set wb = Workbooks.Open(fPath)
Set sht = wb.Worksheets(1)
sht.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
wb.Close False
fName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "OK!"
End Sub