Pravween Raam
asked on
Excel VBA to consolidate multiple workbooks into one
Hi Experts. I was able to source this VBA code from a question answered but I need to modify it slightly. I have X number of workbooks with Y number of worksheets in each book. I have information that I would like to compile onto a single master data workbook. The code below is able to gather the data from the first sheet from all the selected workbooks. I need it to do the same for the remaining worksheets. Please help me with this request! Would really appreciate the help. :)
Sub MergeTest()
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(xlWBATWorksh eet).Works heets(1)
' Open the file dialog box and filter on Excel files, allowing multiple files
' to be selected.
SelectedFiles = Application.GetOpenFilenam e(filefilt er:="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)
' Get row number of last used row
LastRow = WorkBk.Worksheets(1).Cells .Find(What :="*", _
After:=WorkBk.Worksheets(1 ).Cells.Ra nge("A1"), _
SearchDirection:=xlPreviou s, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows).Row
' Set the cell in column N to be the file name.
SummarySheet.Range("N" & NRow).Value = FileName
' Create header row
Set SourceRange = WorkBk.Worksheets(1).Range ("A1:W1")
Set DestRange = SummarySheet.Range("A1:W1" )
DestRange.Value = SourceRange.Value
' Set the source range to be B1 through M?.
' Modify this range for your workbooks. It can span multiple rows.
Set SourceRange = WorkBk.Worksheets(1).Range ("A2:W" & LastRow)
' Set the destination range to start at column A and be the same size as the source range.
Set DestRange = SummarySheet.Range("A" & NRow)
Set DestRange = DestRange.Resize(SourceRan ge.Rows.Co unt, 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.AutoF it
End Sub
Sub MergeTest()
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(xlWBATWorksh
' Open the file dialog box and filter on Excel files, allowing multiple files
' to be selected.
SelectedFiles = Application.GetOpenFilenam
' 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)
' Get row number of last used row
LastRow = WorkBk.Worksheets(1).Cells
After:=WorkBk.Worksheets(1
SearchDirection:=xlPreviou
LookIn:=xlFormulas, _
SearchOrder:=xlByRows).Row
' Set the cell in column N to be the file name.
SummarySheet.Range("N" & NRow).Value = FileName
' Create header row
Set SourceRange = WorkBk.Worksheets(1).Range
Set DestRange = SummarySheet.Range("A1:W1"
DestRange.Value = SourceRange.Value
' Set the source range to be B1 through M?.
' Modify this range for your workbooks. It can span multiple rows.
Set SourceRange = WorkBk.Worksheets(1).Range
' Set the destination range to start at column A and be the same size as the source range.
Set DestRange = SummarySheet.Range("A" & NRow)
Set DestRange = DestRange.Resize(SourceRan
' 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.AutoF
End Sub
ASKER
In each excel workbook, I have lets say 10 sheets. This workbook is sent out to my team to fill up.
In the master file, I would like to keep the original 10 sheets with the data to be drawn from the workbooks submitted by the teams.
In the above 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.
Thanks!
In the master file, I would like to keep the original 10 sheets with the data to be drawn from the workbooks submitted by the teams.
In the above 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.
Thanks!
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Great service and help!
to modify the code is no sweat but please clarify your request.
gowflow