[COLOR="Navy"]Sub[/COLOR] MG14May39
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Rws [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Variant, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
Rws = IIf(Rng.Count / 3 = Int(Rng.Count / 3), Rng.Count / 3, Int(Rng.Count / 3 + 1))
Rng.Offset(, 1).Resize(, 3).ClearContents
[COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] Rng.Count Mod 3
[COLOR="Navy"]Case[/COLOR] 1: R = Array(Rws, Rws - 1, Rws - 1)
[COLOR="Navy"]Case[/COLOR] 2: R = Array(Rws, Rws, Rws - 1)
[COLOR="Navy"]Case[/COLOR] 0: R = Array(Rws, Rws, Rws)
[COLOR="Navy"]End[/COLOR] Select
[COLOR="Navy"]For[/COLOR] Ac = 0 To 2
Cells(2, Ac + 2).Resize(R(Ac)).Value = Rng(1).Offset(c).Resize(R(Ac)).Value
c = c + R(Ac)
[COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]