VBA help with re-arranging data table

[Nhoj01]

Currently faced with the following issue, and can't figure out a solution so thought I'd ask the experts

Data looks like this currently:

ID	Serial	Serial	Serial	Serial	Serial	Serial	Serial	Serial	Serial
1234	12345678 <tbody> </tbody>	12345679 <tbody> </tbody>	12345680 <tbody> </tbody>	12345681 <tbody> </tbody>	12345682 <tbody> </tbody>	12345683 <tbody> </tbody>	12345684 <tbody> </tbody>	12345685 <tbody> </tbody>	12345686 <tbody> </tbody>
1235	12345678	12345679	12345680	12345681	12345682	12345683
1236	12345678	12345679	12345680	12345681	12345682	12345683	12345684	12345685

<tbody>
</tbody>

Goal is to get the data looking like this:

ID	Serial
1234	12345678 <tbody> </tbody>
1234	12345679 <tbody> </tbody>
1234	12345680 <tbody> </tbody>
1234	12345681 <tbody> </tbody>
1234	12345682 <tbody> </tbody>
1234	12345683 <tbody> </tbody>
1234	12345684 <tbody> </tbody>
1234	12345685 <tbody> </tbody>
1234	12345686 <tbody> </tbody>
1235	12345678 <tbody> </tbody>
1235	12345679 <tbody> </tbody>
1235	12345680 <tbody> </tbody>
1235	12345681 <tbody> </tbody>
1235	12345682 <tbody> </tbody>
1235	12345683 <tbody> </tbody>
1236	12345678 <tbody> </tbody>
1236	12345679 <tbody> </tbody>
1236	12345680 <tbody> </tbody>
1236	12345681 <tbody> </tbody>
1236	12345682 <tbody> </tbody>
1236	12345683 <tbody> </tbody>
1236	12345684 <tbody> </tbody>
1236	12345685 <tbody> </tbody>

<tbody>
</tbody>

Any ideas?

 

[MickG]

This code Assumes there are no Blank Cells in column "A" Data.
Results start sheet2 ,"A1"

[COLOR="Navy"]Sub[/COLOR] MG06Jan28
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
 Ray = ActiveSheet.Range("A1").CurrentRegion
  ReDim nRay(1 To UBound(Ray, 1) * UBound(Ray, 2) + 1, 1 To 2)
    nRay(1, 1) = "ID": nRay(1, 2) = "Serial"
    c = 1
    [COLOR="Navy"]For[/COLOR] Rw = 2 To UBound(Ray, 1)
        [COLOR="Navy"]For[/COLOR] Ac = 2 To UBound(Ray, 2)
              [COLOR="Navy"]If[/COLOR] Not Ray(Rw, Ac) = vbNullString [COLOR="Navy"]Then[/COLOR]
                  c = c + 1
                  nRay(c, 1) = Ray(Rw, 1)
                  nRay(c, 2) = Ray(Rw, Ac)
              [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] Ac
  [COLOR="Navy"]Next[/COLOR] Rw
Sheets("Sheet2").Range("A1").Resize(c, 2) = nRay
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Nhoj01]

Mick, that is spot on, many thanks! Much appreciated.

 

[MickG]

You're welcome