VBA to consolidate multiple workbooks into one

November 25, 2016 at 05:40:45
Specs: Windows 7
Hi Experts,

I need a help in consolidating multiple workbooks into one master workbook

Consolidation should happen based on the Header row Meaning if I have country in Column C of Source file and "country" in Column J of Master file the data should get appended based on the same.

2. all the source files will be in one folder and has a dynamic sheet name; meaning one file will have as Denmark, and other might have as "France"

The master file columns are split in the below mentioned pattern

Column A,B,E,F,Q,R,S,T has Formulas(vlookup and some othe funtions)
Column C,D,G,H,I,J,K,L,M,N,O (data needs to be picked from source files)
Column P should pick the sheet name of source file and update in column p of master file

below is the code that i found on internet which is similar but need to map by header column name


'Merge a range from all workbooks in a folder (below each other)
Sub ConsolidateSalesReports()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long, Fnum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim ws As Worksheet
Dim sourceRange As Range, destrange As Range
Dim rnum As Long, CalcMode As Long, lr As Long, lc As Long

'Fill in the path\folder where the files are
MyPath = "C:\Users\Nirvana\Sales reports"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

'Add a new workbook with one sheet
Set BaseWks = ActiveWorkbook.Worksheets("Summary")
rnum = 7
With BaseWks
lr = .Cells(Rows.Count, "A").End(xlUp).Row
If Not rnum = lr + 1 Then
.Range(.Cells(rnum, 1), .Cells(lr, 10)).ClearContents
End If
lr = 0
End With

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0

If Not mybook Is Nothing Then

On Error Resume Next

Set ws = mybook.Worksheets(2)
With ws
lr = .Cells(Rows.Count, "A").End(xlUp).Row
lc = .Cells(1, Columns.Count).End(xlToLeft).Column
Set sourceRange = .Range(.Cells(2, 1), .Cells(lr, lc))
sFilename = ws.Name
End With

If Err.Number > 0 Then
Err.Clear
Set sourceRange = Nothing
End If
On Error GoTo 0

If Not sourceRange Is Nothing Then

SourceRcount = sourceRange.Rows.Count

If rnum + SourceRcount >= BaseWks.Rows.Count Then
MsgBox "Sorry there are not enough rows in the sheet"
BaseWks.Columns.AutoFit
mybook.Close savechanges:=False
GoTo ExitTheSub
Else

'Set the destination range
Set destrange = BaseWks.Range("C" & rnum)

'we copy the values from the sourceRange to the destrange
sourceRange.Copy
With destrange
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

'Copy the file name and formulas
With sourceRange
BaseWks.Cells(rnum, "J"). _
Resize(.Rows.Count).Value = sFilename
BaseWks.Cells(rnum, "A"). _
Resize(.Rows.Count).FormulaR1C1 = "=RC[3]*2"
BaseWks.Cells(rnum, "B"). _
Resize(.Rows.Count).FormulaR1C1 = "=RC[3]*5"
BaseWks.Cells(rnum, "H"). _
Resize(.Rows.Count).FormulaR1C1 = "=RC[-2]*0.5%"
BaseWks.Cells(rnum, "I"). _
Resize(.Rows.Count).FormulaR1C1 = "=RC[-2]*0.5%"
End With

rnum = rnum + SourceRcount
End If
End If
mybook.Close savechanges:=False
End If

Next Fnum
BaseWks.Columns.AutoFit
End If

ExitTheSub:
'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub


See More: VBA to consolidate multiple workbooks into one

Report •

#1
November 26, 2016 at 09:40:52
found some code on the page
http://stackoverflow.com/questions/...
but not sure how to add both

Report •
Related Solutions


Ask Question