Sub SpecialSort()
Dim i As Integer, R As String, j As Integer
Range("N2:Z2").Formula = "=Countif($N$1:$Z$1,""<=""&N1)"
R = ""
For i = 1 To 13
Cells(2, 28) = i
j = Application.WorksheetFunction.Match(Application.WorksheetFunction.Small(Range("N2:Z2"), Cells(2, 28)), Range("N2:Z2"), 0)
Cells(2, 27) = j
R = R & Cells(1, Cells(2, 27) + 13) & ","
Next
R = Left(R, Len(R) - 1)
Cells(1, 27) = R
Rows("2").EntireRow.Delete
End Sub
Your posted sample may be too small to read. In my lame example, you can change "Small" to "Large" to change the order.