<

Combine all of your sheets data into one sheet

Published on
12,274 Points
4,374 Views
4 Endorsements
Last Modified:
Approved
Community Pick

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

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.
4
Author:jppinto
Ask questions about what you read
If you have a question about something within an article, you can receive help directly from the article author. Experts Exchange article authors are available to answer questions and further the discussion.
Get 7 days free