How to Flatten {1, {2, {3, 4}, 5}, 6} into {1, {2, 3, 4, 5}, 6}

lst = {1, {2, {3, 4}, 5}, 6};
FlattenAt[lst, {2, 2}]

{1, {2, 3, 4, 5}, 6}

Also

Map[## & @@ # &, lst, {2}]

{1, {2, 3, 4, 5}, 6}

Replace[lst, List -> Sequence, {3}, Heads -> True]

{1, {2, 3, 4, 5}, 6}

And

☺ = ## & @@@ # & /@ # &;
☺ @ lst

{1, {2, 3, 4, 5}, 6}

We've got a few answers already, but here's my 2 cents:

Replace[l_List :> Flatten[l]] /@ {1, {2, {3, 4}, 5}, 6}

{1, {2, 3, 4, 5}, 6}

This will work:

l = {1, {2, {3, 4}, 5}, 6}
MapAt[Flatten, l, 2]

{1, {2, 3, 4, 5}, 6}

also:

# /. x_ /; Length[x] > 1 :> Flatten@x & /@ l

{1, {2, 3, 4, 5}, 6}