Option Explicit

Dim z, iRow, iCol, arr(), i, Номер

Sub ГазонЗасеян_РавноМерно()
' http://www.excelworld.ru/forum/2-36648-1
'распределить 78 кубикjd в 13 кластеров, так что бы разница между _
  массами кластеров была наиболее минимальна
    With ActiveSheet
        Range(.Cells(2, 4), .Cells(14, 15)).ClearContents
        z = .Cells(2, 1).CurrentRegion.Sort(.Cells(2, 2), xlAscending, Header:=xlYes)
        arr = .[a1].CurrentRegion.Value
        For iRow = 2 To 14
            For iCol = 4 To 14 Step 2
                If iRow Mod 2 = 0 Then
                    .Cells(iRow, iCol + 1) = МаксВес
                Else
                    .Cells(iRow, iCol + 1) = МинВес
                End If
                .Cells(iRow, iCol) = Номер
            Next
        Next
    End With
End Sub

Private Function МаксВес()
    МаксВес = 0    'пусть нет отрицательных чисел _
                   и вес отсортирован по возрастанию
    For i = UBound(arr) To LBound(arr) + 1 Step -1
        If arr(i, 2) <> "" Then
            МаксВес = arr(i, 2)
            arr(i, 2) = ""
            Номер = arr(i, 1)
            Exit For
        End If
    Next
End Function

Private Function МинВес()
    МинВес = 0    'пусть нет отрицательных чисел _
                  и вес отсортирован по возрастанию
    For i = LBound(arr) + 1 To UBound(arr) - 1
        If arr(i, 2) <> "" Then
            МинВес = arr(i, 2)
            arr(i, 2) = ""
            Номер = arr(i, 1)
            Exit For
        End If
    Next
End Function

=B2+A2%%%