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.