Sub Макрос2()
Dim r As Range
  For Each r In ActiveSheet.UsedRange.Rows
    r.Sort r(1), xlAscending, Orientation:=xlSortRows
  Next
End Sub

Sub ArrSort(mass(), ByVal n%)
Dim a%, b%, c%, i%, xx%, jj%, mm, x1%
Dim arr%(), arr0%(), sArr()
  If UBound(mass, 2) < 2 Then Exit Sub
  ReDim arr(1 To UBound(mass, 2))
  ReDim arr0(1 To UBound(mass, 2)): xx = 1
  For i = 1 To UBound(mass, 2): arr(i) = i: Next
  b = UBound(mass, 2): c = b / 1.247331: i = 1
  Do While c > 2
    Do While i + c <= b
      If mass(n, arr(i)) > mass(n, arr(i + c)) Then
        x1 = arr(i): arr(i) = arr(i + c): arr(i + c) = x1
      End If
      i = i + 1
    Loop
    c = c / 1.247331: i = 1
  Loop
  jj = xx: arr0(xx) = arr(1)
  For c = 2 To b
    xx = xx + 1: x1 = xx
    mm = mass(n, arr(c))
    Do While mass(n, arr0(x1 - 1)) > mm
      arr0(x1) = arr0(x1 - 1): x1 = x1 - 1
      If x1 = jj Then Exit Do
    Loop
    arr0(x1) = arr(c)
  Next
  ReDim sArr(1 To UBound(mass, 1), 1 To UBound(mass, 2))
  For a = 1 To UBound(arr0)
    For c = 1 To UBound(mass, 1)
      sArr(c, a) = mass(c, arr0(a))
    Next c
  Next a: Erase arr: Erase arr0
  mass = sArr: Erase sArr
End Sub

ArrSort mass(), 1
Call (ArrSort mass(), 1)