004不同工作簿复制指定名称工作表

将需要汇总的工作簿放在同一个目录，并新建一个名为" 汇总.xls"的工作簿 ，一个名为" 代码.xls"的工作簿。将下面的代码放入代码.xls，并将代码里的“销售明细表”替换成需要汇总的工作表名称。运行即可。

Sub 汇总()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wb, wb1 As Excel.Workbook
Dim sh, sht As Excel.Worksheet
Dim i, r As Integer
On Error Resume Next
For i = 2 To Sheets.Count
Sheets(i).Delete
Next i
Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\汇总.xls")
For i = 2 To wb1.Worksheets.Count
wb1.Worksheets(i).Delete
Next i
f = Dir(ThisWorkbook.Path & "\*.xls*") '生成查找EXCEL的目录,可以适应不同版本
Do While f <> "" '在目录中循环
If f <> ThisWorkbook.Name And f <> wb1.Name Then '如果不是打开的工作簿
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f) '依次打开目录工作薄
wb.Worksheets("销售明细表").Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
  ThisWorkbook.Activate
ActiveSheet.Name = Split(wb.Name, ".")(0)
  wb.Worksheets("销售明细表").Copy after:=wb1.Worksheets(wb1.Worksheets.Count)
   wb1.Activate
ActiveSheet.Name = Split(wb.Name, ".")(0)
    wb.Close False '关闭打开的工作薄
    End If
    f = Dir
    Loop '结束循环
    wb1.Close True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub