REAL-TIME

VBA Projects

Full Access with Source Code

  • Designed and Developed by PNRao

  • Full Access with VBA Source Code

  • Well Commented Codes Lines

  • Creative and Professional Design

120+ PROFESSIONAL

Project Management Templates

120+ PM Templates Includes:
  • 50+ Excel Templates

  • 50+ PowerPoint Templates

  • 25+ Word Templates

Effortlessly Manage Your Projects

Seamlessly manage your projects with our powerful & multi-purpose templates for project management.

Share Post

Append data from multiple Worksheets into a single sheet By Column using VBA:Project Objective

VBA to Append the data in multiple Worksheets to a newly created Worksheet in the same workbook at the end of the column. The ranges in all worksheets are Append into the ‘Append_Dat’ Worksheet(final Worksheet) one after another in column wise at the end of the column. If data is not available in the Source Worksheet(i.e Input Worksheet) , data will not be updated in the Append_Data(Final) 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 Append 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 column.

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

  • Step 1: Declarations: We will declaring required variables and objects which are using in 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(Append_Data 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 at the end of the column.
  • Step 5.2: Find Last used Row and Last used column: Now we have to find the last row and last 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, DstCol 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 ‘Append_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("Append_Data").Delete
Application.DisplayAlerts = True

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

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

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

And if statement is checking the Input sheet(Input Data) and destination sheet(Append_Data 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 Append to Append_Data Worksheet.

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

Step 5.1: Finding the last column in the ‘Append_Data’ Worksheet using ‘fn_LastColumn ‘ function.

DstCol = fn_LastColumn(DstSht)

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)
       LstCol = fn_LastColumn(Sht)
       EnRange = Sht.Cells(LstRow, LstCol).Address
       Set SrcRng = Sht.Range("A1:" & EnRange)

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

     If DstCol + SrcRng.Columns.Count > DstSht.Columns.Count Then
            MsgBox "There are not enough columns to place the data in the Append_Data worksheet."
            GoTo IfError
        End If

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

SrcRng.Copy Destination:=DstSht.Cells(1, DstCol + 1)  

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 Append data from different Worksheets from the Workbook at the end of the column.

Sub Append_Data_From_Different_Sheets_Into_Single_Sheet_By_Column()
'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, DstCol 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 Append_Data WorkSheet if it exists
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Append_Data").Delete
Application.DisplayAlerts = True

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

'5. Loop through each WorkSheet in the workbook and copy the data to the 'Append_Data' WorkSheet
For Each Sht In ActiveWorkbook.Worksheets
    If Sht.Name <> DstSht.Name Then
       '5.1: Find the last row on the 'Append_Data' sheet
       DstCol = fn_LastColumn(DstSht)
           
       If DstCol = 1 Then DstCol = 0
               
       '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 columns in the 'Append_Data' Worksheet
        If DstCol + SrcRng.Columns.Count > DstSht.Columns.Count Then
            MsgBox "There are not enough columns to place the data in the Append_Data worksheet."
            GoTo IfError
        End If
                
      '5.4: Copy data to the 'Append_Data' WorkSheet
        SrcRng.Copy Destination:=DstSht.Cells(2, DstCol + 1)
    End If
Next
DstSht.Range("A1") = "You can place the heading in the first column"

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
'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 

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.

Consolidate data from different sheets By Column

Effortlessly Manage Your Projects and Resources
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.

Save Up to 85% LIMITED TIME OFFER
Project Management Templates

All-in-One Pack
120+ Project Management Templates

Essential Pack
50+ PM Templates

Excel Pack
50+ Excel PM Templates

PowerPoint Pack
50+ Excel PM Templates

MS Word Pack
25+ Word PM Templates

Ultimate Project
Management Template
Ultimate Resource
Management Template
Project Portfolio
Management Templates
Last Updated: March 2, 2023

2 Comments

  1. sunil September 18, 2016 at 10:17 PM - Reply

    given procedure moves all the contents of the worksheets. I want to move only referenced cell content to get a report. How can this be achieved. say for example range c4:c9, F9:G9, B13:f45.

  2. Jyoti April 30, 2019 at 5:08 PM - Reply

    Very useful stuff, Thanks very much for sharing

Leave A Comment