Найти наибольший элемент и поменять его местами с соответствующим диагональным элементом

Sub Q()
 
Dim n As Long, polmax As Long
Dim MatArr()
Dim TotalArr()
Dim MatArrP()
 
n = InputBox("Ââåäèòå ðàçìåðíîñòü ìàòðèöû")
 
ReDim Preserve MatArr(1 To n, 1 To n)
 
For i = 1 To n
   For j = 1 To n
   
   MatArr(i, j) = Int(10 * Rnd())
   
   Next j
Next i
 
Set wsh = ActiveSheet
Cells.Clear
 
wsh.Cells(1, 1).Value = "Èñõîäíàÿ ìàòðèöà"
 
For i = 1 To n
   For j = 1 To n
 
   wsh.Cells(i + 1, j).Value = MatArr(i, j)
 
   Next j
Next i
 
 
ReDim Preserve TotalArr(1 To n)
 
 
j = 0
i = 0
For i = 1 To n
   For j = 1 To n
   
   TotalArr(j) = MatArr(i, j)
   
   Next j
 
 
            Max = TotalArr(1)
            MaxIn = 1
            For Ti = 1 To n
                
                If TotalArr(Ti) > Max Then
                    Max = TotalArr(Ti)
                    polmax = Ti
                Else
                    If TotalArr(Ti) = Max And Ti = 1 Then
                       polmax = MaxIn
                    End If
                End If
                
            Next Ti
 
 
    ReDim Preserve MatArrP(1 To n, 1 To n)
 
           
               For s = 1 To n
 
               If s <> i Then
                  If s <> polmax Then
                    MatArrP(i, s) = MatArr(i, s)
                  Else
                      MatArrP(i, s) = MatArr(i, i)
                  End If
               Else
                   MatArrP(i, s) = Max
                   MatArrP(i, polmax) = MatArr(i, s)
               End If
 
               Next s
 
Next i
   
 
wsh.Cells(n + 2, 1).Value = "Ïðåîáðàçîâàííàÿ ìàòðèöà"
 
For i = 1 To n
   For j = 1 To n
 
   wsh.Cells(n + i + 2, j).Value = MatArrP(i, j)
 
   Next j
Next i
 
 
End Sub