Option Explicit
    Dim lastColumn As Long
    Dim firstColumn As Long
    Dim rangeOfValues As range
    Dim i As Long
    Dim j As Long
    Dim temp As Long
    Dim valuesArray() As Long
    Dim cellChecked As range
    Dim counter As Integer
Sub mainProcedure()
    Call IdentificationRangeOfValues
    Call AuxBubbleSort
    Call BubbleSort
End Sub
Sub IdentificationRangeOfValues()
    With Worksheets(2)
        lastColumn = .Cells(10, .Columns.Count).End(xlToLeft).Column
        If lastColumn <= 0 Then MsgBox "Величина lastColumn: " & lastColumn: Exit Sub
        firstColumn = .range("A10:FXD10").Find("*").Column
        If firstColumn <= 0 Then MsgBox "Величина FirstColumn: " & firstColumn: Exit Sub
        Set rangeOfValues = .Cells(10, firstColumn).Resize(1, lastColumn - firstColumn + 1)
'        MsgBox rangeOfValues.Cells.Count
    End With
End Sub
Sub AuxBubbleSort()
    ReDim valuesArray(1 To rangeOfValues.Cells.Count)
    counter = 1
    For Each cellChecked In rangeOfValues
        valuesArray(counter) = cellChecked
        counter = counter + 1
    Next cellChecked
End Sub
Sub BubbleSort()
    For i = LBound(valuesArray) To UBound(valuesArray) - 1
        For j = i + 1 To UBound(valuesArray)
            If valuesArray(i) > valuesArray(j) Then
                temp = valuesArray(j)
                valuesArray(j) = valuesArray(i)
                valuesArray(i) = temp
            End If
        Next j
    Next i
End Sub

Sub Start()
  Dim a, b
  a = [b10].CurrentRegion
  [b12].Resize(UBound(a), UBound(a, 2)) = SortUpToDown(a)
  [b13].Resize(UBound(a), UBound(a, 2)) = SortDownToUp(a)
End Sub

Function SortUpToDown(b)
  Dim a, i&, j&, k&, c
  a = b
  For i = 2 To UBound(a, 2)
    For j = 1 To i - 1
      If a(1, i) > a(1, j) Then
        c = a(1, i)
        For k = i To j + 1 Step -1: a(1, k) = a(1, k - 1): Next
        a(1, j) = c: Exit For
      End If
    Next
  Next
  SortUpToDown = a
End Function

Function SortDownToUp(b)
  Dim a, i&, j&, k&, c
  a = b
  For i = 2 To UBound(a, 2)
    For j = 1 To i - 1
      If a(1, i) < a(1, j) Then
        c = a(1, i)
        For k = i To j + 1 Step -1: a(1, k) = a(1, k - 1): Next
        a(1, j) = c: Exit For
      End If
    Next
  Next
  SortDownToUp = a
End Function

Function SortTo(What, Optional How$ = ">")
  Dim a, i&, j&, k&, c, cnd As Boolean
  a = What
  For i = 2 To UBound(a, 2)
    For j = 1 To i - 1
      If How = ">" Then cnd = a(1, i) > a(1, j) Else cnd = a(1, i) < a(1, j)
      If cnd Then
        c = a(1, i)
        For k = i To j + 1 Step -1: a(1, k) = a(1, k - 1): Next
        a(1, j) = c: Exit For
      End If
    Next
  Next
  SortTo = a
End Function