鼠标放在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
("")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
点击运行子程序 等待些许时间即可完成。