如何批量复制不同文档中的工作表

liangshiwo

现有文档名称1、 2、3、4、5、6、7
每个文档中都有一个叫buy的工作表，如何将1-7文档中的buy工作表复制到新建文档8中变成buy1、buy2、buy3...buy7
由于工作表多 文档多，怎么批量复制不同工作表

hanhan12

Sub 批量复制工作表()
   Dim MYSHT As Worksheet, WB As Workbook, FSO As Object, MYFD As Object, FS As Object, F
   Set MYSHT = ThisWorkbook.Sheets(1) '把Sheets(1)中的1改成实际要复制的工作表,可用工作表名称(需加引号,"工作表名称")
   Set FSO = CreateObject("Scripting.FileSystemObject")
   Set MYFD = FSO.GETFOLDER(ThisWorkbook.Path & "\文件夹1") '根据实际文件夹名修改
   Set FS = MYFD.Files
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   For Each F In FS
    Set WB = Workbooks.Open(F.Path)
    MYSHT.Copy , WB.Sheets(WB.Sheets.Count)
    WB.Close True
   Next
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True
   Set MYSHT = Nothing
   Set FSO = Nothing
   Set MYFD = Nothing
   Set FS = Nothing
   Set WB = Nothing
End Sub