■

1列目（AAとか）は数字ということですが、001ということは書式が文字列に
なっているということになりますかね。
とりあえず、その場合でも動くようにしておきました。

横方向のソートをどうするか迷いましたが、最終３列を作業列にして縦に並べて
処理の早いワークシートでソートしました。
横方向にソートした後、縦方向に一番小さい数字を求め、それ以外に横３セルの
空白を入れて行くという処理の流れになります。

Sub Macro()
    Dim i As Long
    Dim c As Long
    Dim r As Long
    Dim lastRow As Long
    Dim minNum As Long
    
    lastRow = Cells(Rows.Count, "AA").End(xlUp).Row
    
    For i = 1 To lastRow
        Columns("IT:IT").NumberFormatLocal = "@"
        r = 1
        For c = 27 To 84 Step 3
            Cells(r, "IT").Value = Cells(i, c).Value
            Cells(r, "IU").Value = Cells(i, c + 1).Value
            Cells(r, "IV").Value = Cells(i, c + 2).Value
            r = r + 1
        Next c
        Range("IT:IV").Sort Key1:=Range("IT1"), Order1:=xlAscending, Header:= _
            xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            SortMethod:=xlPinYin, DataOption1:=xlSortNormal
        
        r = 1
        For c = 27 To 84 Step 3
            Cells(i, c).Value = Cells(r, "IT").Value
            Cells(i, c + 1).Value = Cells(r, "IU").Value
            Cells(i, c + 2).Value = Cells(r, "IV").Value
            r = r + 1
        Next c
        
        Columns("IT:IV").Clear
    Next i
    
    c = 27
    Do
        minNum = 1000
        For i = 1 To lastRow
            If Cells(i, c).Value <> "" Then
                If Cells(i, c).Value < minNum Then
                    minNum = Cells(i, c).Value
                End If
            End If
        Next i
        
        If minNum = 1000 Then
            Exit Do
        Else
            For i = 1 To lastRow
                If Cells(i, c).Value <> minNum And Cells(i, c).Value <> "" Then
                    Range(Cells(i, c), Cells(i, c + 2)).Insert Shift:=xlToRight
                End If
            Next i
        End If
        
        c = c + 3
    Loop
End Sub