Sum from Unlimited Multiply sheets and put the total amount in master sheet-CodePudding

I have a code but I don't know why it's not showing the total sum of all sheets in the sheet(summary) it has to show the total sum of all sheets in any column of the sheet (summary) And all the sum have to be separate like sheet1 in "A1", Sheet2 in "A2" and go on to all other sheets like that. I'd have attached the image also what I'm doing Just one more thing I want to do is work on the Unlimited worksheet skipping the worksheet(summary).


Sub SheetsSum()
Dim ws              As Worksheet
Dim X               As Double
Dim arrTotalSum()   As Variant

With ThisWorkbook
 
    
    For Each ws In .Worksheets
        If ws.name <> "Summary" Then
          
             X = X   1
            ReDim arrTotalSum(1 To .Worksheets.Count, 1 To 2)
            arrTotalSum(X, 1) = "Total  " & ws.name
            arrTotalSum(X, 2) = Application.WorksheetFunction.sum(ws.Range("D4:E6"))
           
        End If
    Next ws
 
    .Sheets(1).Range("A1").Resize(X, 2).Value = arrTotalSum
End With

End Sub

CodePudding user response：

You forgot to preserve the values in the array where you store the sums

ReDim Preserve arrTotalSum(1 To .Worksheets.Count, 1 To 2)

As you put this statement in the loop without preserve it will erase all values in the array that were put there in the previous loop run..

Or you put your declaration before the loop what would be the better solution anyway

Sub SheetsSum()
    Dim ws              As Worksheet
    Dim X               As Double
    Dim arrTotalSum()   As Variant

    With ThisWorkbook
 
        ReDim arrTotalSum(1 To .Worksheets.Count, 1 To 2)
    
        For Each ws In .Worksheets
            If ws.Name <> "Summary" Then
          
                X = X   1
                'ReDim Preserve arrTotalSum(1 To .Worksheets.Count, 1 To 2)
                arrTotalSum(X, 1) = "Total  " & ws.Name
                arrTotalSum(X, 2) = Application.WorksheetFunction.Sum(ws.Range("D4:E6"))
           
            End If
        Next ws
 
        .Sheets(1).Range("A1").Resize(X, 2).Value = arrTotalSum
    End With

End Sub