Tranpose ROW Header (YearWeek) and Qty to COL Lists

[Spirax]

Current Report
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Cust Code
[/TD]
[TD]Plant code
[/TD]
[TD]Vendor code
[/TD]
[TD]201822
[/TD]
[TD]201823
[/TD]
[TD]201824
[/TD]
[TD]201825
[/TD]
[TD]201826
[/TD]
[/TR]
[TR]
[TD]C1
[/TD]
[TD]P1
[/TD]
[TD]V1
[/TD]
[TD]1
[/TD]
[TD][/TD]
[TD]4
[/TD]
[TD]1
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C2
[/TD]
[TD]P2
[/TD]
[TD]V2
[/TD]
[TD][/TD]
[TD]2
[/TD]
[TD][/TD]
[TD][/TD]
[TD]3
[/TD]
[/TR]
</tbody>[/TABLE]


New Report - easily to do excel formular later
Cust code-Plant code-Vendor code becoming new header, empty cell are ignored

[TABLE="class: grid, width: 150"]
<tbody>[TR]
[TD]C1
[/TD]
[TD]P1
[/TD]
[TD]V1
[/TD]
[/TR]
[TR]
[TD]201822
[/TD]
[TD]1
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]201824
[/TD]
[TD]4
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]201825
[/TD]
[TD]1
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C2
[/TD]
[TD]P2
[/TD]
[TD]V2
[/TD]
[/TR]
[TR]
[TD]201823
[/TD]
[TD]2
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]201826
[/TD]
[TD]3
[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Thank to advised vba method

 

[MickG]

Try this for results on sheet2 starting "A1".

[COLOR="Navy"]Sub[/COLOR] MG24May11
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Ray [COLOR="Navy"]As[/COLOR] Variant, n [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.Cells(1).CurrentRegion
ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 3)
[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
    [COLOR="Navy"]If[/COLOR] Application.CountA(Cells(n, 4).Resize(, UBound(Ray, 2) - 4)) > 0 [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        nray(c, 1) = Ray(n, 1)
        nray(c, 2) = Ray(n, 2)
        nray(c, 3) = Ray(n, 3)
      
            [COLOR="Navy"]For[/COLOR] Ac = 4 To UBound(Ray, 2)
                [COLOR="Navy"]If[/COLOR] Not IsEmpty(Ray(n, Ac)) [COLOR="Navy"]Then[/COLOR]
                    c = c + 1
                    nray(c, 1) = Ray(1, Ac)
                    nray(c, 2) = Ray(n, Ac)
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] Ac
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 3)
    .value = nray
    .Borders.Weight = 2
    .Columns.AutoFit
 [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick