"把要彙總的工作簿放在同一資料夾下，再建一個彙總工作簿，把下面程式碼放入彙總工作簿中。 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