我想从多个工作簿复制多个工作表到一个工作簿

Question

我有一个代码，我可以选择工作簿并将get复制到一个工作簿。但问题是我能够将所有工作簿的sheet1复制到我的摘要工作簿的sheet1中，但我想将所有工作簿中的所有工作表复制到我的目标工作簿。请注意，所有工作簿上的工作表名称都是相同的。

下面是我的代码。

Private Sub Merge_All_Click() 

    Dim SummarySheet As Worksheet 
    Dim FolderPath As String 
    Dim SelectedFiles() As Variant 
    Dim NRow As Long 
    Dim FileName As String 
    Dim NFile As Long 
    Dim WorkBk As Workbook 
    Dim SourceRange As Range 
    Dim DestRange As Range 
    Dim LastRow As Long 


    ' Create a new workbook and set a variable to the first sheet. 
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1) 

    ' Modify this folder path to point to the files you want to use. 
    FolderPath = "C:\Users\ivan.emmanuel\Desktop\My Macro" 

    ' Set the current directory to the the folder path. 
    ChDrive FolderPath 
    ChDir FolderPath 

    ' Open the file dialog box and filter on Excel files, allowing multiple files 
    ' to be selected. 
    SelectedFiles = Application.GetOpenFilename(_ 
     filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True) 

    ' NRow keeps track of where to insert new rows in the destination workbook. 
    NRow = 1 

    ' Loop through the list of returned file names 
    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles) 
     ' Set FileName to be the current workbook file name to open. 
     FileName = SelectedFiles(NFile) 

     ' Open the current workbook. 
     Set WorkBk = Workbooks.Open(FileName) 

     ' Set the cell in column A to be the file name. 
     SummarySheet.Range("A" & NRow).Value = FileName 

     ' Set the source range to be A9 through C9. 
     ' Modify this range for your workbooks. It can span multiple rows. 
     LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _ 
       After:=WorkBk.Worksheets(1).Cells.Range("A1"), _ 
       SearchDirection:=xlPrevious, _ 
       LookIn:=xlFormulas, _ 
       SearchOrder:=xlByRows).Row 
     Set SourceRange = WorkBk.Worksheets(1).Range("A1:E" & LastRow) 


     ' Set the destination range to start at column B and be the same size as the source range. 
     Set DestRange = SummarySheet.Range("B" & NRow) 
     Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _ 
      SourceRange.Columns.Count) 

     ' Copy over the values from the source to the destination. 
     DestRange.Value = SourceRange.Value 

     ' Increase NRow so that we know where to copy data next. 
     NRow = NRow + DestRange.Rows.Count 

     ' Close the source workbook without saving changes. 
     WorkBk.Close savechanges:=False 
    Next NFile 

    ' Call AutoFit on the destination sheet so that all data is readable. 
    SummarySheet.Columns.AutoFit 

End Sub 

Answer 1

为了实现必须循环工作簿中的所有工作表。

答：

   Dim SummarySheet As Worksheet 
     Dim FolderPath As String 
     Dim SelectedFiles() As Variant 
     Dim NRow As Long 
     Dim FileName As String 
     Dim NFile As Long 
     Dim WorkBk As Workbook 
     Dim SourceRange As Range 
     Dim DestRange As Range 
     Dim LastRow As Long 
     Sub merge() 


     ' Create a new workbook and set a variable to the first sheet. 
     Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1) 

     ' Modify this folder path to point to the files you want to use. 
     FolderPath = "C:\Users\ivan.emmanuel\Desktop\My Macro" 

     ' Set the current directory to the the folder path. 
     ChDrive FolderPath 
     ChDir FolderPath 

     ' Open the file dialog box and filter on Excel files, allowing multiple files 
     ' to be selected. 
     SelectedFiles = Application.GetOpenFilename(_ 
      filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True) 

     ' NRow keeps track of where to insert new rows in the destination workbook. 
     NRow = 1 

     ' Loop through the list of returned file names 
     For NFile = LBound(SelectedFiles) To UBound(SelectedFiles) 
      ' Set FileName to be the current workbook file name to open. 
      FileName = SelectedFiles(NFile) 

      ' Open the current workbook. 
      Set WorkBk = Workbooks.Open(FileName) 

      ' Set the cell in column A to be the file name. 
      SummarySheet.Range("A" & NRow).Value = FileName 

      ' Set the source range to be A9 through C9. 
      ' Modify this range for your workbooks. It can span multiple rows. 
      LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _ 
        After:=WorkBk.Worksheets(1).Cells.Range("A1"), _ 
        SearchDirection:=xlPrevious, _ 
        LookIn:=xlFormulas, _ 
        SearchOrder:=xlByRows).Row 
     Dim ws As Worksheet      '---------added to for copy from all worksheets 
     For Each ws In Workbook     '-------- 

      Set SourceRange = ws.Range("A1:E" & LastRow) '------------ 


      ' Set the destination range to start at column B and be the same size as the source range. 
      Set DestRange = SummarySheet.Range("B" & NRow) 
      Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _ 
       SourceRange.Columns.Count) 

      ' Copy over the values from the source to the destination. 
      DestRange.Value = SourceRange.Value 

      ' Increase NRow so that we know where to copy data next. 
      NRow = NRow + DestRange.Rows.Count 

     Next          '------------ 
      ' Close the source workbook without saving changes. 
      WorkBk.Close savechanges:=False 
     Next NFile 

     ' Call AutoFit on the destination sheet so that all data is readable. 
     SummarySheet.Columns.AutoFit 

     End Sub