For example you have 100 worksheets of data and all the worksheets has the similar structure. All we would want is getting all the data multiple worksheets consolidated into a single worksheet. Do it in seconds with the following code.

Note: This code assumes that ALL worksheets have the same field structure; same column headings, and the same column order. The code copies all rows into one new worksheet called Master. 

Sub CopyFromWorksheets() 
    Dim wrk As Workbook 'Workbook object - Always good to work with object variables
    Dim sht As Worksheet 'Object for handling worksheets in loop
    Dim trg As Worksheet 'Master Worksheet
    Dim rng As Range 'Range object
    Dim colCount As Integer 'Column count in tables in the worksheets
     
    Set wrk = ActiveWorkbook 'Working in active workbook
     
    For Each sht In wrk.Worksheets 
        If sht.Name = "Master" Then 
            MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _ 
            "Please remove or rename this worksheet since 'Master' would be" & _ 
            "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error" 
            Exit Sub 
        End If 
    Next sht 
     
     'We don't want screen updating
    Application.ScreenUpdating = False 
     
     'Add new worksheet as the last worksheet
    Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count)) 
     'Rename the new worksheet
    trg.Name = "Master" 
     'Get column headers from the first worksheet
     'Column count first
    Set sht = wrk.Worksheets(1) 
    colCount = sht.Cells(1, 255).End(xlToLeft).Column 
     'Now retrieve headers, no copy&paste needed
    With trg.Cells(1, 1).Resize(1, colCount) 
        .Value = sht.Cells(1, 1).Resize(1, colCount).Value 
         'Set font as bold
        .Font.Bold = True 
    End With 
     
     'We can start loop
    For Each sht In wrk.Worksheets 
         'If worksheet in loop is the last one, stop execution (it is Master worksheet)
        If sht.Index = wrk.Worksheets.Count Then 
            Exit For 
        End If 
         'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
        Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount)) 
         'Put data into the Master worksheet
        trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value 
    Next sht 
     'Fit the columns in Master worksheet
    trg.Columns.AutoFit 
     
     'Screen updating should be activated
    Application.ScreenUpdating = True 
End Sub

How to use

  • Open the workbook that contains worksheets you want to combine.
  • Hit Alt+F11 to open the Visual Basic Editor (VBE).
  • From the menu, choose Insert-Module.
  • Copy & Paste the above code into the code window at right.
  • Save the file and close the VBE.

Download Sample File: ConsolidateMultipleWorkSheets.xls

Also Read

Comments

  1. Jay

    The good news is this script successfully created a new worksheet and renamed it Master. The bad news is the rest of the script loops through all of my worksheets and copies & pastes only the first column of data. It doesn’t even copy and paste the column headers.

Leave a Reply

Your email address will not be published. Required fields are marked *

8 − 4 =

This site uses Akismet to reduce spam. Learn how your comment data is processed.