Excle 多个文档合并为一个 分多个sheet页

鼠标放在sheet页标签上邮件选择查看代码
出现
键入一下代码：
Sub Find()
Application.ScreenUpdating = False
Dim MyDir As String
MyDir = ThisWorkbook.Path & “”
ChDrive Left(MyDir, 1) 'find all the excel files
ChDir MyDir
Match = Dir$("") Do If Not LCase(Match) = LCase(ThisWorkbook.Name) Then Workbooks.Open Match, 0 'open ActiveSheet.Copy Before:=ThisWorkbook.Sheets(1) 'copy sheet Windows(Match).Activate ActiveWindow.Close End If Match = Dir$("")DoIfNotLCase(Match)=LCase(ThisWorkbook.Name)ThenWorkbooks.OpenMatch,0′openActiveSheet.CopyBefore:=ThisWorkbook.Sheets(1)′copysheetWindows(Match).ActivateActiveWindow.CloseEndIfMatch=Dir
Loop Until Len(Match) = 0
Application.ScreenUpdating = True
End Sub

点击运行子程序
等待些许时间即可完成。