Consolidate data from multiple Worksheets into a single sheet By Row using VBA:Project Objective

VBA to concatenate the data in multiple Worksheets to a newly created Worksheet in the same workbook. The ranges in all worksheets are concatenated into the consolidated Worksheet(final Worksheet) one after another in rows wise. If data is not available in the Source Worksheet(i.e Input Worksheet) , data will not be updated in the consolidated Worksheet. Following is the step by step detailed explanation to automate this process using VBA..

How we are going to develop this project module(The KEY steps):

To consolidate all worksheets in the workbook, we have to first create a new worksheet(lets call master sheet) and then loop through each worksheet in the workbook. We have to find the valid data range in each worksheet and append to the newly created master sheet at the end of the row.

Let me explain the key steps to develop this project. We are going to write a procedure (Consolidate_Data_From_Different_Sheets_Into_Single_Sheet) with the below approach.

  • Step 1: Declarations: We will declaring required variables and objects which are using in the our procedure.
  • Step 2: Disable the Screen updating and Events: temporarily to avoid screen flickering and events triggering.
  • Step 3: Delete old Master sheet: Before creating new master sheet, we have to check if there is any existing sheet with the same name and delete it.
  • Step 4: Adding new worksheet : Lets add new Master sheet to paste the data from other sheets
  • Step 5: Loop through each sheet: Now,let’s loop through each worksheet (let’s call source sheet) and paste in the master sheet
  • Step 5.1: Find Last Available Row: Now we have to find the last available row in the master sheet to paste the data
  • Step 5.2: Find Last used Row and Last used column: Now we have to find the last row and column of the source sheet
  • Step 5.3: Check if there is enough data: The information got from the above step will helps to check if the data is available in the source sheet
  • Step 5.4: Copy the data if exist: Now, copy the data from source sheet and append to the master sheet
  • Step 6: Enable the Screen updating and Events: Let’s reset the screen updating and events.

Note: We will be creating two user defined functions which we will be using In the steps 5 to find last row and last columns.

Now, let us see the code for each step:

Step 1: Declaring variables which are using in the entire project.

Dim Sht As Worksheet, DstSht As Worksheet
Dim LstRow As Long, LstCol As Long, DstRow As Long
Dim i As Integer, EnRange As String
Dim SrcRng As Range

Step 2: Disable Screen Updating is used to stop screen flickering and Disable Events is used to avoid interrupted dialog boxes / popups.

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Step 3: Deleting the ‘Consolidate_Data’ Worksheet if it exists in the Workbook. And Display Alerts is used to stop popups while deleting Worksheet.

Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Consolidate_Data").Delete
Application.DisplayAlerts = True

Step 4: Adding a new WorkSheet at the end of the Worksheet. Naming as ‘Consolidate_Data’ . And finally it is assigned it to object (DstSht).

With ActiveWorkbook
    Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    DstSht.Name = "Consolidate_Data"
End With

Step 5: It is lLooping through each(or all) WorkSheet in the workbook.

And if statement is checking the Input sheet(Input Data) and destination sheet(Consolidated Sheet) is equal or not. If it is equal then it is going to check next worksheet. If it is not equal to then it copies the input data and concatenate to Consolidated Worksheet.

For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> DstSht.Name Then
End if

Step 5.1: Finding the last row in the ‘Consolidate_Data’ Worksheet using ‘fn_LastRow ‘ function.

DstRow = fn_LastRow(DstSht) + 1

Step 5.2: Finding Last used row and Last used column in the Input Worksheet and assigning it to the objects LstRow and LstRow .

Finding Last used cell address in the Worksheet and assigned it to object EnRange . Finally finding Input data range in the Input Worksheet and assigning it to the ‘SrcRng ‘ object.

LstRow = fn_LastRow(Sht)
       LstRow = fn_LastColumn(Sht)
       EnRange = Sht.Cells(LstRow, LstCol).Address
       Set SrcRng = Sht.Range("A1:" & EnRange)

Step 5.3: Check whether there are enough rows in the ‘Consolidate_Data’ Worksheet. Otherwise it displays message to the user and go to the IfError .

If DstRow + SrcRng.Rows.Count > DstSht.Rows.Count Then
            MsgBox "There are not enough rows to place the data in the Consolidate_Data worksheet."
            GoTo IfError
        End If

Step 5.4: Copying data from the input Worksheet and cocatinating with destination Worksheet.

SrcRng.Copy Destination:=DstSht.Range("A" & DstRow)

Step 6: Enableing Screen Updating and Events at the end of the project.

With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

Final VBA Module Code(Macro):

Please find the following macro to Consolidate data from different Worksheets from the Workbook.

Sub Consolidate_Data_From_Different_Sheets_Into_Single_Sheet()
'Procedure to Consolidate all sheets in a workbook

On Error GoTo IfError

'1. Variables declaration
Dim Sht As Worksheet, DstSht As Worksheet
Dim LstRow As Long, LstCol As Long, DstRow As Long
Dim i As Integer, EnRange As String
Dim SrcRng As Range

'2. Disable Screen Updating - stop screen flickering
'   And Disable Events to avoid inturupted dialogs / popups
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

'3. Delete the Consolidate_Data WorkSheet if it exists
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Consolidate_Data").Delete
Application.DisplayAlerts = True

'4. Add a new WorkSheet and name as 'Consolidate_Data'
With ActiveWorkbook
    Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    DstSht.Name = "Consolidate_Data"
End With

'5. Loop through each WorkSheet in the workbook and copy the data to the 'Consolidate_Data' WorkSheet
For Each Sht In ActiveWorkbook.Worksheets
    If Sht.Name <> DstSht.Name Then
       '5.1: Find the last row on the 'Consolidate_Data' sheet
       DstRow = fn_LastRow(DstSht) + 1
               
       '5.2: Find Input data range
       LstRow = fn_LastRow(Sht)
       LstCol = fn_LastColumn(Sht)
       EnRange = Sht.Cells(LstRow, LstCol).Address
       Set SrcRng = Sht.Range("A1:" & EnRange)
       
       '5.3: Check whether there are enough rows in the 'Consolidate_Data' Worksheet
        If DstRow + SrcRng.Rows.Count > DstSht.Rows.Count Then
            MsgBox "There are not enough rows to place the data in the Consolidate_Data worksheet."
            GoTo IfError
        End If
                
      '5.4: Copy data to the 'consolidated_data' WorkSheet
        SrcRng.Copy Destination:=DstSht.Range("A" & DstRow)
                
    End If

Next

IfError:

'6. Enable Screen Updating and Events
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Below are the two user defined functions which we have created to find the last row and last column of the given worksheet. We have called these functions in the above procedure at step 5.1 and 5.2.

Function to Find Last Row:

The following function will find the last row of the given worksheet. ‘fn_LastRow’ will accept a worksheet(Sht) as input and give the last row as output.

'In this example we are finding the last Row of specified Sheet
Function fn_LastRow(ByVal Sht As Worksheet)

    Dim lastRow As Long
    lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
    lRow = Sht.Cells.SpecialCells(xlLastCell).Row
    Do While Application.CountA(Sht.Rows(lRow)) = 0 And lRow <> 1
        lRow = lRow - 1
    Loop
    fn_LastRow = lRow

End Function

Function to Find Last Column:

The following function will find the last column of the given worksheet. ‘fn_LastColumn’ will accept a worksheet(Sht) as input and give the last column as output.

'In this example we are finding the last column of specified Sheet
Function fn_LastColumn(ByVal Sht As Worksheet)

    Dim lastCol As Long
    lastCol = Sht.Cells.SpecialCells(xlLastCell).Column
    lCol = Sht.Cells.SpecialCells(xlLastCell).Column
    Do While Application.CountA(Sht.Columns(lCol)) = 0 And lCol <> 1
        lCol = lCol - 1
    Loop
    fn_LastColumn = lCol

End Function

Final Module:
Let’s

Instructions to Execute the Procedure:

You can download the below file and see the code and execute it. Or else, you create new workbook and use the above code and test it. Here are the instructions to use above code.

  1. Open VBA Editor window or Press Alt+F11.
  2. Insert a new module from the Insert menu.
  3. Copy the above procedure and functions and paste it in the newly created module.
  4. You can enter some sample data in multiple sheets. and run the procedure.

Download the Project Workbook – Excel Macro File<:

Here is the example Excel macro Workbook to explore yourself.

Download: Consolidate data from different Worksheets into a single Worksheet By Row

Premium Project Management Templates

120+ Professional Project Management Templates!

A Powerful & Multi-purpose Templates for project management. Now seamlessly manage your projects, tasks, meetings, presentations, teams, customers, stakeholders and time. This page describes all the amazing new features and options that come with our premium templates.

PREMIUM TEMPLATES
LIMITED TIME OFFER
ON SALE80% OFF
BROWSE ALL TEMPLATES

Advanced Project Planning Templates

Excel Templates

VIEW DETAILS

120+ Project Management Templates Pack

Excel | PowerPoint | Word

VIEW DETAILS

ULTIMATE RESOURCE MANAGEMENT TEMPLATE

Excel Template

VIEW DETAILS

50+ Essential Project Management Templates

Excel | PowerPoint | Word

VIEW DETAILS

Project Portfolio Management Templates

Excel | PowerPoint Templates

VIEW DETAILS

50+ Excel Project Management Templates

Excel Templates

VIEW DETAILS

Share This Story, Choose Your Platform!

11 Comments

  1. akram January 17, 2017 at 11:10 AM

    Is there a way to remove the line from A1 ”DstSht.Range(“A1”) = “You can place the headeing in the first row” and paste the data from A1 cell instead

  2. akram January 17, 2017 at 11:13 AM

    Also can we specify from which sheets we need data to be consolidated instead of considering all sheets.

  3. Sumit February 1, 2017 at 8:31 PM

    Code works perfectly. This is what I needed. Thank you so very much.

  4. Kathleen June 27, 2017 at 10:51 PM

    Can you advise how you can set a range of sheets to pull data from vs all?

  5. Lindsay Tweed December 12, 2017 at 12:41 AM

    This is coming up with a “sub or Function not defined’ error for step 5.1 “DstRow = fn_LastRow(DstSht) + 1” on mine, any thoughts on how to correct that?

  6. ozz December 22, 2017 at 3:28 PM

    Hi everyone,

    First of all I have to tell that I have no experience with Macro (VBA Codes). However what I need is related to this. Maybe you guys could help me with it.

    I have a workbook and in this workbook there are 10 worksheets. The first 9 Sheets have the same order of the coloumns of titles and in these columns there are names, dates, percentages of Project Status, comments to Projects etc.. As I said the columns have the same order just the name of the worksheets (for different Teams in the Organisation) are different.

    In Addition to this I have to merge all the worksheets and have them in another sheet which is called “Übersicht” (Overview). However there is a different column in the sheet and it’s between “Nr.” and “Thema” columns (which are in A1 and A2 in all the 9 Sheets) and this different column called “Kategorie” (in A2 in Übersicht-Overwiev sheet). As this column is between These the order is like this “Nr. (A1), Kategorie (A2) and Thema (A3)…..”.So this category column (Kategorie) should be empty except this all the Information should be merged into this sheet. And also when there is a Change or update in any worksheet, the Information in “Übersicht” (Overview) sheet needs to update by itself. How can I do this?

    P.S.: Every sheet has different filled rows, some 30, some 13, some 5 etc. And the Teams which are responsible for the Sheets can add or delete some rows (in each row there is different Information for different Projects). This also means the number of rows can increase or decrease.

    I hope I explained it well. Thanks a lot in advance!

    I wish you merry Christmas and a happy new year!

    oduff

  7. Crystal August 3, 2018 at 9:59 PM

    This code works amazing for what I want to do. However, I have 2 questions. How can I get step before “enable screen updating” (“you can place the heading in the first row”), to actually copy any of the first rows in the other sheet. All of my sheets have the same header column. So, I would like the combined sheet to also have that header.

    The second question is how to place the combined sheet as the first tab in the worksheet instead of the last.

    And lastly, I want to copy the format from a previous sheet (using Format Painter on the whole sheet) to the Combined Sheet.

    Thank you so much!

  8. Arash June 10, 2019 at 2:28 AM

    Hello,

    this work perfectly fine but i have sometimes different headers or the headers are in different positions in different sheets.
    How is it possible to
    – have all headers in the same position when creating the master sheet
    – and add extra headers on the end of the master sheet if they are not the same
    – share the xml workbook for more than one party to enter at the same time
    – i have headers on every sheet but the master sheet should be a summary of all headers on not diplicate the headers all the time on the master sheet

  9. pradeep.hatti July 11, 2019 at 6:33 PM

    Please help to correct below, as i am trying to copy data from multy workbook master book , but to copy only date in cell 11- Text =

    Sub DPR_Test1()

    ‘this macro goes IN the master workbook
    Dim wsMaster As Worksheet, Sheet1 As Workbook
    Dim NextRow As Long, lastrow As Long
    Dim FileName As String
    Dim FolderPath As String
    Dim n As Long
    Dim i

    Set wsMaster = ThisWorkbook.Sheets(“Sheet1”)

    ‘Specify the folder path

    FolderPath = “C:\Users\hattip\Desktop\DPR\”

    ‘specifying file name

    FileName = Dir(FolderPath & “*.xls*”)

    Do While FileName “”

    NextRow = wsMaster.Range(“A” & Rows.Count).End(xlUp).Row + 1

    If wbDATA(“sheet1”).Cells(i, 11).Value = “Mexico” Then

    Set wbDATA = Workbooks.Open(FolderPath & FileName)

    With wbDATA.Sheets(“Sheet1”)
    lastrow = .Range(“A” & .Rows.Count).End(xlUp).Row
    ‘ If LastRow > 5 Then
    For i = 2 To lastrow

    .Range(“A2:ah” & i).Copy
    wsMaster.Range(“A” & NextRow).PasteSpecial xlPasteValues
    ‘Set NextRow = NextRow
    Next i
    End With
    FileName = Dir()

    End If
    Application.ScreenUpdating = True

    Loop

    End Sub

  10. mahboob August 27, 2019 at 2:07 PM

    Dear Sir,

    I want learn VBA macros with you.

    Thank you so much for consulate MIS file.

    Please share your contract no.

    My mane is mahboob alam

    I working in Mumbai my designation is MIS.WFM and want learn VBA macros.

  11. VinnieB January 15, 2020 at 1:08 AM

    Code works excellent. Is there a way to add code, so that column “A” contains the tab name for the data in which it comes from? I have 100 tabs all named different with slight changes in the data.

Leave A Comment