Combine all of your sheets data into one sheet

Background

The problem of having multiple repositories of different but related data happens to many people; consequently, many times this can occur within the same workbook. In other words, say that we have a Workbook with dispersed data on multiple Sheets, all with the same configuration: headers on row number one; data starting from row two. Now, what if we needed to see all the data together, we would have to combine the data from all of the sheets into one single sheet, called “Target” (which we want added in the same Workbook).

Solution

Although, the above can and has been done manually countless times, this article will provide you a handy automation macro to accomplish this.

Macro Process Flow
To start, we will delete the Sheet "Target", just in case that it already exists. Then we need to count the number of Sheets that the Workbook has. After that, we will add the new Sheet, "Target", where we will put all of the data. Next we have to go through all of the sheets and identify the last row and last column with data to define the range that should be copied to the Target sheet, using lstrow2 to ensure that the newly copied data from each sheet will be put into the first empty row on the Target sheet. This code assumes that the data is in contiguous columns, that are no blank columns in the middle.
 
On this macro, CombineSheets(), I've set the DisplayAlerts, EnableEvents and ScreenUpdating events to False at the beginning of routine and back to True at the end. This will avoid having the user see the screen moving as well as any alerts during the process of copying the data.

Macro Code

Sub CombineSheets() 
                      
                          'This macro will copy all rows from the first sheet 
                          '(including headers) 
                          'and on the next sheets will copy only the data 
                          '(starting on row 2) 
                      
                          Dim i As Integer 
                          Dim j As Long 
                          Dim SheetCnt As Integer 
                          Dim lstRow1 As Long
                          Dim lstRow2 As Long
                          Dim lstCol As Integer 
                          Dim ws1 As Worksheet 
                      
                          With Application 
                              .DisplayAlerts = False 
                              .EnableEvents = False 
                              .ScreenUpdating = False 
                          End With 
                      
                          On Error Resume Next 
                      
                          'Delete the Target Sheet on the document (in case it exists) 
                          Sheets("Target").Delete 
                          'Count the number of sheets on the Workbook 
                          SheetCnt = Worksheets.Count 
                      
                          'Add the Target Sheet 
                          Sheets.Add after:=Worksheets(SheetCnt) 
                          ActiveSheet.Name = "Target" 
                          Set ws1 = Sheets("Target") 
                          lstRow2 = 1 
                          'Define the row where to start copying 
                          '(first sheet will be row 1 to include headers) 
                          j = 1 
                      
                          'Combine the sheets 
                          For i = 1 To SheetCnt 
                              Worksheets(i).Select 
                      
                              'check what is the last column with data 
                              lstCol = ActiveSheet.Cells(1, Activesheet.Columns.Count).End(xlToLeft).Column 
                      
                              'check what is the last row with data 
                              lstRow1 = ActiveSheet.Cells(activesheet.rows.count, "A").End(xlUp).Row
                      
                              'Define the range to copy 
                              Range("A" & j, Cells(lstRow1, lstCol)).Select 
                      
                              'Copy the data 
                              Selection.Copy 
                              ws1.Range("A" & lstRow2).PasteSpecial 
                              Application.CutCopyMode = False 
                      
                              'Define the new last row on the Target sheet 
                              lstRow2 = ws1.Cells(65536, "A").End(xlUp).Row + 1 
                      
                              'Define the row where to start copying 
                              '(2nd sheet onwards will be row 2 to only get data) 
                              j = 2 
                          Next 
                      
                          With Application 
                              .DisplayAlerts = True 
                              .EnableEvents = True 
                              .ScreenUpdating = True 
                          End With 
                      
                          Sheets("Target").Select 
                          Cells.EntireColumn.AutoFit 
                          Range("A1").Select 
                      
                      End Sub
                      

Select all Open in new window

Combining disparate but like structured data is a common task that many Excel users do manually, but using a macro to automate the task makes life much easier; therefore, I hope that you have found this article and the CombineSheets() macro useful.