Consolidate Data from Multiple Worksheets into a Master Worksheet in Excel using VBA

For example you have 100 worksheets of data and all the worksheets has the similar structure. All we would want is getting all the data multiple worksheets consolidated into a single worksheet. Do it in seconds with the following code.

Note: This code assumes that ALL worksheets have the same field structure; same column headings, and the same column order. The code copies all rows into one new worksheet called Master. 

Sub CopyFromWorksheets() 
Dim wrk As Workbook 'Workbook object - Always good to work with object variables
Dim sht As Worksheet 'Object for handling worksheets in loop
Dim trg As Worksheet 'Master Worksheet
Dim rng As Range 'Range object
Dim colCount As Integer 'Column count in tables in the worksheets
Set wrk = ActiveWorkbook 'Working in active workbook
For Each sht In wrk.Worksheets 
If sht.Name = "Master" Then 
MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _ 
"Please remove or rename this worksheet since 'Master' would be" & _ 
"the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error" 
Exit Sub 
End If 
Next sht 
'We don't want screen updating
Application.ScreenUpdating = False 
'Add new worksheet as the last worksheet
Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count)) 
'Rename the new worksheet
trg.Name = "Master" 
'Get column headers from the first worksheet
'Column count first
Set sht = wrk.Worksheets(1) 
colCount = sht.Cells(1, 255).End(xlToLeft).Column 
'Now retrieve headers, no copy&paste needed
With trg.Cells(1, 1).Resize(1, colCount) 
.Value = sht.Cells(1, 1).Resize(1, colCount).Value 
'Set font as bold
.Font.Bold = True 
End With 
'We can start loop
For Each sht In wrk.Worksheets 
'If worksheet in loop is the last one, stop execution (it is Master worksheet)
If sht.Index = wrk.Worksheets.Count Then 
Exit For 
End If 
'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount)) 
'Put data into the Master worksheet
trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value 
Next sht 
'Fit the columns in Master worksheet
trg.Columns.AutoFit 
'Screen updating should be activated
Application.ScreenUpdating = True 
End Sub

How to use

  • Open the workbook that contains worksheets you want to combine.
  • Hit Alt+F11 to open the Visual Basic Editor (VBE).
  • From the menu, choose Insert-Module.
  • Copy & Paste the above code into the code window at right.
  • Save the file and close the VBE.

Download Sample File: ConsolidateMultipleWorkSheets.xls

Also Read

Show Comments

No Responses Yet

Leave a Reply