VBA Excel , How to extract max value in an specific column and show the max value in Specific sheet

Question

What I am trying to to achieve is the max value in all sheets in my workbook and gather them in an specific sheet My vba code is working for one specific cell and when I have tried to add for loops Nothing happen and my excel would be not respond and freeze I will be thankful if any one could help.

Dim wsDst As Worksheet
Dim ws As Worksheet
Dim x As Long
Dim lngMax As Long
Set wsDst = Sheets("Summary")
 Application.ScreenUpdating = False
  For Each ws In ActiveWorkbook.Worksheets

    If ws.Name <> wsDst.Name And ws.Name <> "Amirhossein" Then
       For ZZ = 4 To 9999
        For Q = 25 To 9999
         With ws
            x = Application.WorksheetFunction.max(.Cells(ZZ, 26))
            If x > lngMax Then
                wsDst.Cells(Q, 10).Value = x
                lngMax = wsDst.Cells(Q, 10).Value
            End If
        End With
    Next Q
    Next ZZ

    End If
Next ws

Answer 1

Try the next version, please. It checks each value of cells value from X:Z columns and extract Max, which is placed in the same cell of 'Summary' sheet:

Sub testMaxXZMultipleSheets()
  Dim sh As Worksheet, wsDst As Worksheet, arr, arrRng
  Dim k As Long, i As Long, j As Long
  
  Set wsDst = Sheets("Summary")
  ReDim arr(ThisWorkbook.Worksheets.Count - 1) 'redim the array to the maximum number of sheets
  For Each sh In ThisWorkbook.Sheets           'put all sheet objects in the arr array
    If sh.Name <> wsDst.Name And sh.Name <> "Amirhossein" Then
        Set arr(k) = sh: k = k + 1
    End If
  Next
  ReDim Preserve arr(k - 1) 'keep only the array elements keeping a sheet object
  For j = 24 To 26          'iterate only between columns X:Z (24:26):
    For m = 4 To arr(1).Range("X" & Rows.Count).End(xlUp).Row 'it assumes that all shets have the same number of rows
        ReDim arrRng(UBound(arr))
        For i = 0 To UBound(arr)        'create an array of each value of the same cell for all sheets in arr array
          arrRng(i) = IIf(IsError(arr(i).Cells(m, j).Value), 0, arr(i).Cells(m, j).Value)
        Next i
        wsDst.Cells(m, j).Value = WorksheetFunction.max(arrRng) 'put the Max value in the same 'Summary' position
    Next m
 Next j
 MsgBox "Ready..."
End Sub

Please, send some feedback after testing it.