Sub Tri()
Dim MonTab, OK As Boolean, Trans1, Trans2, Trans3, x As Long
MonTab = Range("B4:P6")
Do
OK = True
For i = 2 To UBound(MonTab, 2) - 1
If MonTab(2, i) > MonTab(2, i + 1) Then
Trans1 = MonTab(1, i)
Trans2 = MonTab(2, i)
Trans3 = MonTab(3, i)
MonTab(1, i) = MonTab(1, i + 1)
MonTab(2, i) = MonTab(2, i + 1)
MonTab(3, i) = MonTab(3, i + 1)
MonTab(1, i + 1) = Trans1
MonTab(2, i + 1) = Trans2
MonTab(3, i + 1) = Trans3
OK = False
End If
Next
x = x + 1
Loop While Not OK
Range("B4").Resize(UBound(MonTab, 1), UBound(MonTab, 2)) = MonTab
End Sub