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

I have a code but I don't know why it's not showing the total count of all sheets in the sheet(summary) it has to show the total count of all sheets in any column of the sheet (summary) And all the count 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) and don't count 0 zero.

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

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

End Sub

CodePudding user response：

As said in my other answer it's best to have the ReDim outside the loop if possible. A preserve is an "expensive" operation and unless it is really neccessary to do a ReDim Preserve avoid it

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

    With ThisWorkbook
 
        ' A preserve is an "expensive" operation
        ' Unless it is really neccessary to do a ReDim Preserve avoid it
        ' especially in a loop
        ReDim arrTotalSum(1 To .Worksheets.Count, 1 To 2)
        
        For Each ws In .Worksheets
            If ws.Name <> "cover" Then
          
                X = X   1
                
                arrTotalSum(X, 1) = "Quantity  " & ws.Name
                arrTotalSum(X, 2) = Application.WorksheetFunction.CountIf(ws.Range("D4:E6"), ">0")
           
            End If
        Next ws
 
        .Sheets(1).Range("A1").Resize(X, 2).Value = arrTotalSum
    End With

End Sub