n = 6; f1 = {}; f2 = {}; x = 0; p = PartitionsP[n]; d = ConstantArray[Null, {p, n}]; For[i = n, i > 0, i--, r = DeleteCases[Sort@PadRight[Reverse/@Cases[IntegerPartitions[i], x_ /; Last[x]!=1]], x_ /; x==0,2]; AppendTo[f1, {{p - PartitionsP[i] + 1, p}, {1, i}} -> Thick]; For[j = Length[r], j > 0, j--, rj = r[[j]]; y = 1; x++; For[k = Length[rj], k > 0, k--, rjk = rj[[k]]; d[[x, y]] = rjk; y = y + rjk; AppendTo[f2, {{x, x}, {y - rjk, y - 1}} -> Thin]]]; d[[p - PartitionsP[i - 1] + 1 ;; p, i]] = 1]; Grid[d, Frame -> {None, None, Join[f2, f1]}] (* ~~~~ *)