"把要彙總的工作簿放在同一資料夾下，再建一個彙總工作簿，把下面程式碼放入彙總工作簿中。

Sub ABCD()

Dim lj As String

Dim dirname As String

Dim nm As String

lj = ActiveWorkbook.Path

nm = ActiveWorkbook.Name

dirname = Dir(lj & "\*.xls")

Cells.Clear

Do While dirname ""

If dirname nm Then

Workbooks.Open Filename:=lj & "\" & dirname

Workbooks(nm).Activate

Workbooks(dirname).Sheets(1).Range("A4:J15").Copy _

Sheets(1).Range("a65536").End(xlUp).Offset(1, 0)

Workbooks(dirname).Close False

End If

dirname = Dir

Loop

Rows("1:1").Select

Selection.Delete Shift:=xlUp

End Sub