Sum the same table across different number of worksheets

Consolidate Worksheets

Links (Microsoft Docs)

Description

  • In the workbook containing this code (ThisWorkbook), the following will consolidate (in this case sum up (xlSum)) all the same ranges (srcRange) in all worksheets with names starting with a specified string (srcLead) into another worksheet (tgtName) starting from a specified cell (tgtFirst).

The Code

Option Explicit

Sub consolidateWorksheets()
    
    ' Define constants.
    Const srcRange As String = "K7:CI31"
    Const srcLead As String = "Total_"
    Const tgtName As String = "Récapitulatif"
    Const tgtFirst As String = "A1"
    
    ' Define workbook.
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    ' Define Target Worksheet.
    Dim tgt As Worksheet
    Set tgt = wb.Worksheets(tgtName)
    
    ' Define R1C1-Style Source Ranges Address.
    Dim rcRng As String
    rcRng = tgt.Range(srcRange).Address(ReferenceStyle:=xlR1C1)
    
    ' Define Consolidation Array.
    Dim Data As Variant
    ReDim Data(1 To wb.Worksheets.Count)
    
    ' Declare variables.
    Dim ws As Worksheet         ' Current Source Worksheet
    Dim CurrentName As String   ' Current Source Worksheet Name
    Dim n As Long               ' Current Element in Consolidation Array
    
    ' Write full paths of Source Worksheets to Consolidation Array.
    For Each ws In wb.Worksheets
        CurrentName = ws.Name
        If InStr(1, CurrentName, srcLead, vbTextCompare) = 1 Then
            n = n + 1
            Data(n) = "'" & ws.Name & "'!" & rcRng
        End If
    Next ws
    
    ' Validate and resize Consolidation Array.
    If n = 0 Then
        MsgBox "No worksheets to consolidate.", vbCritical, "Fail"
        Exit Sub
    End If
    ReDim Preserve Data(1 To n)
    
    ' Consolidate.
    tgt.Range(tgtFirst).Consolidate Sources:=Data, _
                                    Function:=xlSum
    
    ' Inform user.
    MsgBox "Data consolidated.", vbInformation, "Success"

End Sub

CLICK HERE to find out more related problems solutions.

Leave a Comment

Your email address will not be published.

Scroll to Top