Excel VBA to consolidate multiple workbooks into one

[raam90]

[FONT=&quot]Hi Experts. I managed to find a vba to consolidate information from different workbooks into a single sheet but I need help to modify it slightly.

[/FONT][FONT=&quot]I have X number of workbooks. In each excel workbook, I have lets say 10 sheets. This workbook is sent out to my team to fill up. [/FONT]

[FONT=&quot]In the master file, I would like to keep the original 10 sheets headers with the data to be drawn from the workbooks submitted by the teams.[/FONT]

[FONT=&quot]In the below code, it is able to consolidate the data from the various workbooks but it only does so for the first sheet in each workbook, I need it to repeat it for the remaining 9 sheets for example.[/FONT][FONT=&quot] Please help me with this request! Would really appreciate the help. [/FONT]

[FONT=&quot]Sub MergeTest()[/FONT]

[FONT=&quot] Dim SummarySheet As Worksheet[/FONT]
[FONT=&quot] Dim FolderPath As String[/FONT]
[FONT=&quot] Dim SelectedFiles() As Variant[/FONT]
[FONT=&quot] Dim NRow As Long[/FONT]
[FONT=&quot] Dim FileName As String[/FONT]
[FONT=&quot] Dim NFile As Long[/FONT]
[FONT=&quot] Dim WorkBk As Workbook[/FONT]
[FONT=&quot] Dim SourceRange As Range[/FONT]
[FONT=&quot] Dim DestRange As Range[/FONT]
[FONT=&quot] Dim LastRow As Long[/FONT]

[FONT=&quot] ' Create a new workbook and set a variable to the first sheet.[/FONT]
[FONT=&quot] Set SummarySheet = Workbooks.Add(xlWBATWorksh[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">[FONT=&quot]eet).Works[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">[FONT=&quot]heets(1)[/FONT]

[FONT=&quot] ' Open the file dialog box and filter on Excel files, allowing multiple files[/FONT]
[FONT=&quot] ' to be selected.[/FONT]
[FONT=&quot] SelectedFiles = Application.GetOpenFilenam[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">[FONT=&quot]e(filefilt[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">[FONT=&quot]er:="Excel[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">[FONT=&quot] Files (*.xl*), *.xl*", MultiSelect:=True)[/FONT]

[FONT=&quot] ' NRow keeps track of where to insert new rows in the destination workbook.[/FONT]
[FONT=&quot] NRow = 1[/FONT]

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

[FONT=&quot] ' Open the current workbook.[/FONT]
[FONT=&quot] Set WorkBk = Workbooks.Open(FileName)[/FONT]

[FONT=&quot] ' Get row number of last used row[/FONT]
[FONT=&quot] LastRow = WorkBk.Worksheets(1).Cells[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">[FONT=&quot].Find(What[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">[FONT=&quot]:="*", _[/FONT]
[FONT=&quot] After:=WorkBk.Worksheets(1[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">[FONT=&quot]).Cells.Ra[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">[FONT=&quot]nge("A1"),[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">[FONT=&quot] _[/FONT]
[FONT=&quot] SearchDirection:=xlPreviou[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">[FONT=&quot]s, _[/FONT]
[FONT=&quot] LookIn:=xlFormulas, _[/FONT]
[FONT=&quot] SearchOrder:=xlByRows).Row[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">

[FONT=&quot] ' Set the cell in column N to be the file name.[/FONT]
[FONT=&quot] SummarySheet.Range("N" & NRow).Value = FileName[/FONT]
[FONT=&quot] [/FONT]
[FONT=&quot] ' Create header row[/FONT]
[FONT=&quot] Set SourceRange = WorkBk.Worksheets(1).Range[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">[FONT=&quot]("A1:W1")[/FONT]
[FONT=&quot] Set DestRange = SummarySheet.Range("A1:W1"[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">[FONT=&quot])[/FONT]
[FONT=&quot] DestRange.Value = SourceRange.Value[/FONT]

[FONT=&quot] ' Set the source range to be B1 through M?.[/FONT]
[FONT=&quot] ' Modify this range for your workbooks. It can span multiple rows.[/FONT]
[FONT=&quot] Set SourceRange = WorkBk.Worksheets(1).Range[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">[FONT=&quot]("A2:W" & LastRow)[/FONT]

[FONT=&quot] ' Set the destination range to start at column A and be the same size as the source range.[/FONT]
[FONT=&quot] Set DestRange = SummarySheet.Range("A" & NRow)[/FONT]
[FONT=&quot] Set DestRange = DestRange.Resize(SourceRan[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">[FONT=&quot]ge.Rows.Co[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">[FONT=&quot]unt, SourceRange.Columns.Count)[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">

[FONT=&quot] ' Copy over the values from the source to the destination.[/FONT]
[FONT=&quot] DestRange.Value = SourceRange.Value[/FONT]

[FONT=&quot] ' Increase NRow so that we know where to copy data next.[/FONT]
[FONT=&quot] NRow = NRow + DestRange.Rows.Count[/FONT]

[FONT=&quot] ' Close the source workbook without saving changes.[/FONT]
[FONT=&quot] WorkBk.Close savechanges:=False[/FONT]
[FONT=&quot] Next NFile[/FONT]

[FONT=&quot] ' Call AutoFit on the destination sheet so that all data is readable.[/FONT]
[FONT=&quot] SummarySheet.Columns.AutoF[/FONT]<wbr style="font-size: 16px; font-family: "Open Sans", sans-serif;">[FONT=&quot]it[/FONT]
[FONT=&quot]End Sub[/FONT]