Sub melange()
Dim i, j, k, xcell As Range, S
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("b7:b" & Rows.Count).ClearContents
For Each xcell In Range("h14:j14")
S = S + xcell
For j = 1 To xcell.Value
Range("b7").Offset(k) = xcell.Offset(-1)
k = k + 1
Next j
Next xcell
Columns("B:B").Insert Shift:=xlToRight
Range("b7").Resize(S).FormulaLocal = "=alea()"
Range("b7").Resize(S, 2).Sort key1:=Range("b7"), Header:=xlNo
Columns("B:B").Delete
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub