Отсортировать по столбцам все элементы матрицы в порядке убывания

Sub test()
Dim K(1 To 5, 1 To 6)
 
For i = 1 To 5
  For j = 1 To 6
    K(i, j) = Int(Rnd * 50)
  Next j
Next i
 
Dim outputStr As String
outputStr = "Arr1="
For i = 1 To UBound(K, 1)
  For j = 1 To UBound(K, 2)
    outputStr = outputStr & vbTab & K(i, j)
  Next j
  outputStr = outputStr & vbCrLf
Next i
 
 
Dim CountOfSubst
CountOfSubst = 0
 
For i = 1 To UBound(K, 2)
  CountOfSubst = CountOfSubst + sort(K, i)
Next i
 
Dim maximums()
ReDim maximums(1 To UBound(K, 2))
outputStr = outputStr & "Max:"
For i = 1 To UBound(K, 2)
  maximums(i) = K(1, i)
  For j = 1 To UBound(K, 1)
    If maximums(i) < K(j, i) Then maximums(i) = K(j, i)
  Next j
  outputStr = outputStr & vbTab & maximums(i)
Next
 
outputStr = outputStr & vbCrLf & vbCrLf & "Arr2="
For i = 1 To UBound(K, 1)
  For j = 1 To UBound(K, 2)
    outputStr = outputStr & vbTab & K(i, j)
  Next j
  outputStr = outputStr & vbCrLf
Next i
 
 
MsgBox outputStr
End Sub
 
 
Function sort(ByRef Arr, C) As Integer
'return - number of substitution
'Arr - array
'C - column for sort
sort = 0
cols = UBound(Arr, 1) 'column's
 
If cols >= C Then
  For i = 1 To cols + 1
    For j = cols To i + 1 Step -1
      If Arr(j - 1, C) < Arr(j, C) Then
        tmp = Arr(j - 1, C)
        Arr(j - 1, C) = Arr(j, C)
        Arr(j, C) = tmp
        sort = sort + 1
      End If
    Next j
  Next i
End If
End Function