I have created but don't know what to add a code to put the total amount of all multiply sheet in the master or 1st sheet "A1" please help I'm newcomer please help if there is better code please tell me

Sub sum()

Dim i As Integer

Dim ws_num As Integer
Dim ws As Workbook
Dim sh As Worksheet
Dim sumrg As Range


For Each sh In Sheets
If sh.Name <> "coverletter" Then
ws_num = ThisWorkbook.Worksheets.Count

For i = 1 To ws_num
ThisWorkbook.Worksheets(i).Activate
Set sumrg = ActiveSheet.Range("C5:D14")
Range("H4").Value = WorksheetFunction.sum(sumrg)
Next i
End If
Next


End Sub

CodePudding user response：

Asad, please try this. The code will write the total sum in the sheet number 1.

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

With ThisWorkbook
 'First Calculate the different Sums.
    X = 1
    For Each ws In .Worksheets
        If ws.Name <> "coverletter" Then
          'The idea is to prepare an Array and store the summed values.
            ReDim Preserve arrTotalSum(1 To 2, 1 To X)
            arrTotalSum(1, X) = "Total of Sheet " & ws.Name
            arrTotalSum(2, X) = Application.WorksheetFunction.sum(ws.Range("C5:D14"))
            X = X   1
        End If
    Next ws
  'To write the values, we need to Transpose the Array, from columns to rows.
    .Sheets(1).Range("A1").Resize(UBound(arrTotalSum, 2), UBound(arrTotalSum, 1)).Value = Application.WorksheetFunction.Transpose(arrTotalSum)
End With

End Sub

Also, do not name subs or function with similar name of actual excel vba function.

CodePudding user response：

Sum Up the Values of a Range

• In VBA, both flavors of Sum will fail if there are error values in the range:
  • The early-bound WorksheetFunction.Sum, short for Application.WorksheetFunction.Sum, will raise an error.
  • The late-bound Application.Sum will return an error value.
• You can use the NumRangeSum function to always get the sum of a range (even if it is non-contiguous).

Sub UpdateSums()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("CoverLetter")
    Dim sCell As Range: Set sCell = sws.Range("A1") ' first source cell
    
    Dim dws As Worksheet
    Dim rSum As Variant ' for the procedure not to fail if error values
    ' If you use the function then you can safely use the correct:
    'Dim rSum As Double
    ' The same goes for if you are sure there are no error values.
    
    For Each dws In wb.Worksheets
        If Not dws Is sws Then ' is not the source worksheet
            ' This will result in an error value if there is an error value
            ' in the range.
            rSum = Application.Sum(dws.Range("C5:D14"))
            ' To prevent this, you can instead use the function:
            'rSum = NumRangeSum(dws.Range("C5:D14"))
            dws.Range("H4").Value = rSum
            sCell.Value = rSum
            Set sCell = sCell.Offset(1) ' next source cell below
        'Else ' is the source worksheet; do nothing
        End If
    Next dws
    
    MsgBox "Sums updated.", vbInformation

End Sub


Function NumRangeSum(ByVal mrg As Range) As Double

    Dim mrSum As Variant: mrSum = Application.Sum(mrg)
    
    Dim tSum As Double
    
    If IsNumeric(mrSum) Then ' is a number
        tSum = CDbl(mrSum)
    Else ' is an error value
        
        Dim arg As Range
        Dim aData() As Variant, aValue As Variant
        Dim ar As Long, arCount As Long, ac As Long, acCount As Long
        
        For Each arg In mrg.Areas
            aValue = Application.Sum(arg)
            If IsNumeric(aValue) Then ' is a number
                tSum = tSum   CDbl(aValue)
            Else ' is an error value
                arCount = arg.Rows.Count
                acCount = arg.Columns.Count
                If arCount * acCount = 1 Then ' one cell
                    ReDim aData(1 To 1, 1 To 1): aData(1, 1) = arg.Value
                Else ' multiple cells
                    aData = arg.Value
                End If
                For ar = 1 To arCount
                    For ac = 1 To acCount
                        aValue = aData(ar, ac)
                        If VarType(aValue) = vbDouble Then ' is a number
                            tSum = tSum   CDbl(aValue)
                        'Else ' is not a number; do nothing
                        End If
                    Next ac
                Next ar
            End If
        Next arg
    
    End If
    
    NumRangeSum = tSum

End Function