Excel VBA Consolidate worksheets with same structure into one worksheet

This Excel tutorial explains how to use Excel VBA to consolidate worksheets with same structure into one worksheet.

You may also want to read:

Excel VBA combine worksheets columns into one worksheet

Excel VBA consolidate multiple workbooks into one workbook

Consolidate worksheets with same structure into one worksheet

In database, we can use UNION to combine two tables with the same structure. In this tutorial, I will create a Macro to consolidate worksheets with same structure into one worksheet.

Example: To consolidate all worksheets with name that contain “salary” to worksheet “consol” (currently not exist)

Assumption: You have three worksheets – “salary1”, “salary2″,”others”

consol04        consol05

Step 1: Alt+F11 > insert a Module > Paste the VBA code below

Public Sub consolWS()
    Dim dataShtNm As String  'the sheet name of source data
    Dim consolShtNm As String
    Dim consolLastRow, loopedShtLastRow, loopedShtLastCol As String
    Dim msgboxRslt As Integer
    consolShtNm = InputBox("Enter the worksheet name that you want to consolidate data in")
    If consolShtNm = "" Then
        msgboxRsltDummy = MsgBox("Action cancel", vbInformation)
        Exit Sub
    Else
        dataShtNm = InputBox("Enter wildcard conditions for worksheet name that you want to consolidate data from" & vbCrLf & vbCrLf & "For example, type data* to combine all worksheet with name starts with 'data' (case sensitive)" & vbCrLf & vbCrLf & "Type * to conslidate all worksheets except the consol sheet iteslf")
        If dataShtNm = "" Then
            msgboxRsltDummy = MsgBox("Action cancel", vbInformation)
            Exit Sub
        Else
            If WorksheetExists(consolShtNm) = False Then  'if consolidation worksheet does not exists
                msgboxRslt1 = MsgBox("Worksheet '" & consolShtNm & "' not found, a new worksheet will be created now", vbOKCancel + vbExclamation)
                If msgboxRslt1 = 1 Then  'user confirm to create new worksheet
                    Sheets.Add().Name = consolShtNm
                    For Each sht In ActiveWorkbook.Worksheets
                        If sht.Name <> consolShtNm And sht.Name Like dataShtNm Then
                            Sheets(sht.Name).Range("A1:XFC1").Copy (Sheets(consolShtNm).Range("B1:XFD1")) 'copy worksheet header
                            consolLastRow = colLastRow(consolShtNm, "B")   'check the last row in consol sheet
                            loopedShtLastRow = colLastRow(sht.Name, "A") 'check the last row in current looped sheet
                            loopedShtLastCol = rowLastColNm(sht.Name, 1) 'check the last column in current looped sheet
                            Sheets(sht.Name).Range("A2", loopedShtLastCol & loopedShtLastRow).Copy  'copy all data in looped sheet
                            Sheets(consolShtNm).Activate
                            Sheets(consolShtNm).Range("B" & consolLastRow + 1).Select
                            ActiveSheet.Paste Link:=True
                            For i = consolLastRow + 1 To consolLastRow + loopedShtLastRow - 1
                              ActiveSheet.Range("A" & i).Value = sht.Name
                            Next i
                        End If
                    Next sht
                Else 'user cancel create new worksheet
                    msgboxRsltDummy = MsgBox("Action cancel", vbInformation)
                    Exit Sub
                End If
            Else  'if consolidation worksheet already exists
                msgboxRslt2 = MsgBox("Worksheet '" & consolShtNm & "' already exists, new data will be appended beginning from the last record", vbOKCancel + vbExclamation)
                If msgboxRslt2 = 2 Then   'user cancel append data to last record of desired worksheet
                    dummy = MsgBox("Action cancel", vbInformation)
                Else
                    For Each sht In ActiveWorkbook.Worksheets
                        If sht.Name <> consolShtNm And sht.Name Like dataShtNm Then
                            Sheets(sht.Name).Range("A1:XFC1").Copy (Sheets(consolShtNm).Range("B1:XFD1")) 'copy worksheet header
                            consolLastRow = colLastRow(consolShtNm, "B")   'check the last row in consol sheet
                            loopedShtLastRow = colLastRow(sht.Name, "A") 'check the last row in current looped sheet
                            loopedShtLastCol = rowLastColNm(sht.Name, 1) 'check the last column in current looped sheet
                            Sheets(sht.Name).Range("A2", loopedShtLastCol & loopedShtLastRow).Copy  'copy all data in looped sheet
                            Sheets(consolShtNm).Activate
                            Sheets(consolShtNm).Range("B" & consolLastRow + 1).Select
                            ActiveSheet.Paste Link:=True
                            
                            For i = consolLastRow + 1 To consolLastRow + loopedShtLastRow - 1
                              ActiveSheet.Range("A" & i).Value = sht.Name
                            Next i
                        End If
                    Next sht
                End If
            End If
        End If
    End If

    If WorksheetExists(consolShtNm) Then  'to prevent blank cell value referencing as zero
       For Each Rng In Sheets(consolShtNm).UsedRange
          If WorksheetFunction.IsFormula(Rng) And wCountSubStr(Rng.Formula, "!") = 1 Then
             rngFormula = Replace(CStr(Rng.Formula), "=", "")
             Rng.Formula = "=if(isblank(" & rngFormula & "),""""," & rngFormula & ")"
          End If
       Next Rng
    End If
End Sub

Public Function colLastRow(worksheetNm As String, colNm As String) As Integer
    colLastRow = Worksheets(worksheetNm).Range(colNm & Rows.Count).End(xlUp).Row
End Function

Public Function rowLastColNum(worksheetNm As String, rowNum) As Integer
    rowLastColNum = Worksheets(worksheetNm).Range("IV" & rowNum).End(xlToLeft).Column
End Function

Public Function rowLastColNm(worksheetNm As String, rowNum) As String
    Dim rowLastColNum As Integer
    rowLastColNum = Worksheets(worksheetNm).Range("IV" & rowNum).End(xlToLeft).Column
    rowLastColNm = Split(Cells(1, rowLastColNum).Address, "$")(1)
End Function

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
    On Error Resume Next
    WorksheetExists = (Sheets(WorksheetName).Name <> "")
    On Error GoTo 0
End Function

Public Function wCountSubStr(str As String, substr As String) As Integer
   lenstr = Len(str)
   lensubstr = Len(substr)
 
   For i = 1 To lenstr
      tempString = Mid(str, i, lensubstr)
      If tempString = substr Then
         Count = Count + 1
      End If
   Next i
   wCountSubStr = Count
End Function

Step 2: Run the Procedure

Navigate to Developer > Macros > select consolWS > Run

Step 3: Enter consolidation worksheet name

Type consol, then press OK

consol01

Step 4: Enter worksheet name to consolidate

Since we want to consolidate only salary related worksheets, type salary* and then press OK

Note that Wildcard condition is case sensitive

consol02

Wildcard Meaning Example
* Represents one or more characters (any character) J*     any text that starts with J
*J     starts with any text but ends with J
*J*   any text that has J in the middle
? Represents one character (any character) J?     2 characters that start with J
?J     2 characters that end with J
?J?   3 characters with J in the middle
~ Treat * or ? as the actual character but not wildcard. Used ~ followed by * or ? J~**   any text that starts with J*
~**J   any text that starts with * and ends with J
~?*~* any text that starts with ? and ends with *

Step 5: Confirm creation of new worksheet

If you already have a worksheet called “consol”, you will not see this message. Click on OK.

consol03

Result

In the “consol” worksheet, you will find the following result.

  • Header of consol sheet in row 1 copies from the last matching worksheet
  • Consolidation order is from the left worksheet to the right worksheet, in this example, worksheet “salary2” is on the left
  • You can continue to run the Macro to append more data in consol worksheet at the bottom

 

 

Leave a Reply

Your email address will not be published.