In this article, we will create a macro to copy data from all the sheets in the workbook to a new sheet.
Raw data for this example consists of employee details from different departments in different sheets. We want to consolidate employee details into a single sheet.
We have created “CopyRangeFromMultipleSheets” macro for the consolidation of the data. This macro can be run by clicking “Consolidate data” button.
Macro will create a new worksheet and insert the consolidated data from all the worksheets.
‘Looping’ through all sheets to check whether “Master” sheet exists.
For Each Source In ThisWorkbook.Worksheets
If Source.Name = “Master” Then
MsgBox “Master sheet already exists”
Above code is used to check whether “Master” sheet exists in the workbook. If “Master” sheet exists in the workbook, then code exits and an error message is displayed.
Above code is used to get the row number of last cell in the sheet.
Source.Range(“A1″, Range(“A1″).SpecialCells(xlLastCell)).Copy Destination.Range(“A” & DestLastRow)
Above code is used to copy the specified range to the defined cell.
Please follow below for the code
Sub CopyRangeFromMultipleSheets() 'Declaring variables Dim Source As Worksheet Dim Destination As Worksheet Dim SourceLastRow, DestLastRow As Long Application.ScreenUpdating = False 'Looping through all sheets to check whether "Master" sheet exist For Each Source In ThisWorkbook.Worksheets If Source.Name = "Master" Then MsgBox "Master sheet already exist" Exit Sub End If Next 'Inserting a new sheet after the "Main" sheet Set Destination = Worksheets.Add(after:=Sheets("Main")) Destination.Name = "Master" 'Looping through all the sheets in the workbook For Each Source In ThisWorkbook.Worksheets 'Preventing consolidation of data from "Main" and "Master" sheet If Source.Name <> "Main" And Source.Name <> "Master" Then SourceLastRow = Source.Range("A1").SpecialCells(xlLastCell).Row Source.Activate If Source.UsedRange.Count > 1 Then DestLastRow = Sheets("Master").Range("A1").SpecialCells(xlLastCell).Row If DestLastRow = 1 Then 'copying data from the source sheet to destination sheet Source.Range("A1", Range("A1").SpecialCells(xlLastCell)).Copy Destination.Range("A" & DestLastRow) Else Source.Range("A2", Range("A1").SpecialCells(xlCellTypeLastCell)).Copy Destination.Range("A" & (DestLastRow + 1)) End If End If End If Next Destination.Activate Application.ScreenUpdating = True End Sub
We would love to hear from you, do let us know how we can improve our work and make it better for you. Write to us at email@example.com