Vertical to horizontal, repeating 4 records in each group

[selant]

In my file, each data group consists of 4 members. There are lots of groups in my worksheet.
Here is a demo data of first 3 group. "1" , "2" , "3" indicates unique flights.

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]1[/TD]
[TD]DATA1[/TD]
[TD]MEMBER1[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]DATA1[/TD]
[TD]MEMBER2[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]DATA1[/TD]
[TD]MEMBER3[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]DATA1[/TD]
[TD]MEMBER4[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]DATA2[/TD]
[TD]MEMBER5[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]DATA2[/TD]
[TD]MEMBER6[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]DATA2[/TD]
[TD]MEMBER7[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]DATA2[/TD]
[TD]MEMBER8[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]DATA3[/TD]
[TD]MEMBER9[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]DATA3[/TD]
[TD]MEMBER10[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]DATA3[/TD]
[TD]MEMBER11[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]DATA3[/TD]
[TD]MEMBER12[/TD]
[/TR]
</tbody>[/TABLE]

I want to convert the data to a new table such as following :

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]1[/TD]
[TD]DATA1[/TD]
[TD]MEMBER1[/TD]
[TD]MEMBER2[/TD]
[TD]MEMBER3[/TD]
[TD]MEMBER4[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]DATA2[/TD]
[TD]MEMBER5[/TD]
[TD]MEMBER6[/TD]
[TD]MEMBER7[/TD]
[TD]MEMBER8[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]DATA3[/TD]
[TD]MEMBER9[/TD]
[TD]MEMBER10[/TD]
[TD]MEMBER11[/TD]
[TD]MEMBER12[/TD]
[/TR]
</tbody>[/TABLE]

I need some help for a script or such thing to convert the first table to the requested one.

 

[selant]

any helps greatly appreciated

 

[selant]

any helps greatly appreciated

any ideas ?

 

[MickG]

Try this :- Results sheet2.

[COLOR="Navy"]Sub[/COLOR] MG28Aug56
[COLOR="Navy"]Dim[/COLOR] Rng     [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn      [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] oMax    [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K
[COLOR="Navy"]Dim[/COLOR] c       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ac      [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] col     [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Twn     [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
c = 1
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Twn = Dn & "," & Dn.Offset(, 1)
    [COLOR="Navy"]If[/COLOR] Not .Exists(Twn) [COLOR="Navy"]Then[/COLOR]
        .Add Twn, Dn
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]Set[/COLOR] .Item(Twn) = Union(.Item(Twn), Dn)
        oMax = Application.Max(oMax, .Item(Twn).Count)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] n = 1 To oMax
    [COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
        '[COLOR="Green"][B] Alter Headers to names suit ####[/B][/COLOR]
        .Cells(1, 1) = "No" '[COLOR="Green"][B] ####[/B][/COLOR]
        .Cells(1, 2) = "Data" '[COLOR="Green"][B]####[/B][/COLOR]
        .Cells(1, n + 2) = "Member" & n '[COLOR="Green"][B]####[/B][/COLOR]
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    col = 2
    c = c + 1
    Sheets("Sheet2").Cells(c, 1) = Split(K, ",")(0)
    Sheets("Sheet2").Cells(c, 2) = Split(K, ",")(1)
    Sheets("Sheet2").Cells(c, 3).Resize(, .Item(K).Count).Value = Application.Transpose(.Item(K).Offset(, 2).Value)
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[selant]

works very well!!
Thank you MickG