Let’s say that you have a lot of sheets in your workbook and you want to merge all the data onto a single worksheet.
If you have your data laid out in the same way on each sheet then this piece of VBA will do the trick for you. Maybe you have sales reports for different regions/products/salespeople on separate sheets, something like this :
The code allows for a header row (which is taken from the first sheet), and just copies the data off the remaining sheets.
Merging the sheets together will give you this :
Note : I used Excel's RANDBETWEEN function to generate the sales figures. I wasn't going to type out those numbers by hand, and if you need to generate random numbers too, try RANDBETWEEN.
The merged data is copied onto a sheet called MergedData. If you want to change this sheet name, just change the value between the double quotes of the MergeSheetName variable in the VBA as shown here :
When you run the code this is what happens :
- A new sheet called MergedData is created (or whatever you want to call it). If this sheet already exists then all data on it is deleted
- The header row and data from the first sheet in the workbook is copied to the merged data sheet
- The data from all other sheets is copied to the merged data sheet
- The header row on the merged results is made BOLD
- The columns on the merged results are auto-fitted
What to Expect from the VBA
There are certain things the code does not do and it’s important to understand these so you don’t end up with unexpected results
The range to be copied must be contiguous. I use a VBA property called CurrentRegion which copies a range bounded by blank rows/columns like so :
Our active cell is B2 so the range to copy is A2 to F4. CurrentRegion will select the range starting at A1, but I'm resizing the range in VBA to exclude the first row as we've already copied that from the first sheet. We only want the header row once.
Row 6 and Column H are ignored as Row 5 and Column G are blank – these are where CurrentRegion understands the range ends.
You can read Microsoft’s explanation of CurrentRegion here
This code cannot be used on a protected worksheet, CurrentRegion does not support this.
The code pastes values and formatting. So your merged sheet will not contain any formulas
Where’s the Code?
Option Explicit Sub MergeSheets() ' Author - Philip Treacy ' http://www.myonlinetraininghub.com/merge-excel-worksheets-with-vba ' Date - 30 Sep 2013 ' Merge all sheets in a workbook into one summary sheet Dim MergeSheet As Worksheet, wSheet As Worksheet, tempSheet As Worksheet Dim NumRows As Long, StartRow As Long Dim FirstSheet As Boolean Dim MergeSheetName As String Dim copyRange As Range MergeSheetName = "MergedData" Application.ScreenUpdating = False 'Add sheet for merged data if it doesn't exist On Error Resume Next Set tempSheet = Sheets(MergeSheetName) If tempSheet Is Nothing Then Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MergeSheetName End If 'Setup Set MergeSheet = ActiveWorkbook.Sheets(MergeSheetName) MergeSheet.Cells.ClearContents FirstSheet = True StartRow = 2 'Process each data sheet For Each wSheet In Worksheets 'If we are on the sheet where we are copying the merged data to, skip it If wSheet.Name <> MergeSheetName Then 'Calcuate how many rows of data to copy from the sheet NumRows = wSheet.Range("A" & wSheet.Rows.Count).End(xlUp).Row 'Copy header row from first sheet If FirstSheet Then wSheet.Range("A1", wSheet.Cells(1, Columns.Count).End(xlToLeft)).Copy MergeSheet.Range("A1").PasteSpecial xlPasteAll FirstSheet = False End If 'Activate sheet to be copied and select the range of data for copying wSheet.Activate wSheet.Range("A2").Select Set copyRange = ActiveCell.CurrentRegion 'Resize the range to exclude the header row, but copy all other data copyRange.Offset(1, 0).Resize(copyRange.Rows.Count - 1, copyRange.Columns.Count).Copy 'Paste values and formatting MergeSheet.Range("A" & StartRow).PasteSpecial xlPasteValuesAndNumberFormats 'Set StartRow which is where the next lot of data will be pasted into StartRow = MergeSheet.Range("A" & MergeSheet.Rows.Count).End(xlUp).Row + 1 End If Next wSheet 'Tidy Up MergeSheet.Rows(1).Font.Bold = True MergeSheet.Cells.Columns.AutoFit Application.CutCopyMode = False Application.ScreenUpdating = True MergeSheet.Activate Range("A1").Select Set MergeSheet = Nothing Set tempSheet = Nothing End Sub
What do you think?
If you need a hand adapting this to do something else for you please let me know.
This code was written as a result of a question from one of our students, Anna Reifman, thanks Anna.
I’d like to hear from you if you have a problem you think VBA could fix, or if you have your own solution to merging sheets, or even if you have adapted my code to do something else.
I'd be very grateful if you let others know about this using your favourite network. Just click the icons below.