如何将不同工作簿上的同名工作表合并到一个新工作簿中？

Question

我想将文件夹中不同工作簿上的同名工作表合并到一个新工作簿中。

我想让工作表以从中复制它们的文件的名称命名。

Sub collectionOfSheets()

    Dim strF As String, strP As String
    strP = "path to source files folder"                                          
    strF = Dir(strP & "\*.xlsx")

    Workbooks.Add.SaveAs Filename:="filename of destination workbook"
  
    Do While strF <> vbNullString
      Workbooks.Open (strP & "\" & strF)
      ActiveWorkbook.Sheets("Sheet1").Copy Before:=Workbooks("filename of destination workbook").Sheets(1)
      Workbooks("filename of destination workbook").Sheets(1).Name = "strF"
      Workbooks("filename of destination workbook").Save
      strF = Dir()
    Loop

End Sub

Answer 1

试试这个：

Sub collectionOfSheets()

    Dim strF As String, strP As String
    Dim wbNew As Workbook, wb As Workbook
    
    Set wbNew = Workbooks.Add()  'for collecting the sheets
    wbNew.SaveAs Filename:="filename of destination workbook"
    
    strP = "path to source files folder"
    strF = Dir(strP & "\*.xlsx")

    Do While strF <> vbNullString
        Set wb = Workbooks.Open(strP & "\" & strF)
        wb.Sheets("Sheet1").Copy Before:=wbNew.Sheets(1)
        wbNew.Sheets(1).Name = Replace(strF, ".xlsx", "") 'without extension
        wbNew.Save
        wb.Close False 'close ?
        strF = Dir()
    Loop

End Sub

使用工作簿变量可以更轻松地管理流程...