Я хочу скопировать несколько листов из нескольких книг в одну книгу

Question

У меня есть код, с помощью которого я могу выбрать книги и скопировать их в одну книгу. Но проблема в том, что я могу скопировать только лист1 всех книг на лист1 моей сводной рабочей книги, но я хочу скопировать все листы из всех книг в мою целевую книгу. Обратите внимание, что имена листов во всех книгах идентичны.

Ниже приведен код, который у меня есть.

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