把有以下程式碼的excel放入同一個檔案件中，執行就可以了。

Sub XXXX()

Application.ScreenUpdating

= False

Application.DisplayAlerts

= False

Dim MyDir As String

MyDir =

ThisWorkbook.Path

& "\"

ChDrive Left(MyDir, 1) "find all the excel files

ChDir MyDir

Match = Dir$("*.xls")

Do

If Not LCase(Match) = LCase(ThisWorkbook.Name) Then

Workbooks.Open

Match, 0, 0

Rows(1)

.Select

Selection.Delete

Workbooks(Match)

.Activate

ActiveWorkbook.Save

ActiveWorkbook.Close

0

End If

Match = Dir$

Loop Until Len(Match) = 0

Application.ScreenUpdating

= True

Application.DisplayAlerts

= True

End Sub