開啟該新Excel，按Alt+F11進入宏介面，點選單的插入，模組，貼上如下程式碼:Sub Find()Application.ScreenUpdating = FalseDim MyDir As StringMyDir = ThisWorkbook.Path & "\"ChDrive Left(MyDir, 1) "find all the excel filesChDir MyDirMatch = Dir$("")DoIf Not LCase(Match) = LCase(ThisWorkbook.Name) ThenWorkbooks.Open Match, 0 "openActiveSheet.Copy Before:=ThisWorkbook.Sheets(1) "copy sheetWindows(Match).ActivateActiveWindow.CloseEnd IfMatch = Dir$Loop Until Len(Match) = 0Application.ScreenUpdating = TrueEnd Sub在此介面直接按F5執行此宏，完成。