可以按照以下程式操作：

Sub test

Dim wb As Workbook, mypath As String, myfile As String, sht1 As Worksheet,

sht2 As Worksheet, arr

mypath = ThisWorkbook.Path

myfile = Dir(mypath & "\*.xls")

Do Until myfile = ""

If myfile ThisWorkbook.Name Then

Set wb = Workbooks.Open(mypath & "" & myfile)

For Each sht1 In wb.Worksheets

For Each sht2 In Workbooks("原表").Worksheets

If sht2.Name = sht1.Name Then

sht2.Cells.Copy

sht1.Select

sht1.Range("a1").Select

ActiveSheet.Paste

End If

Next

Next

wb.Close 1

End If

myfile = Dir

Loop

End Sub