Transpose and Repeat header

[Snaybot]

Im looking for a macro that transposes my header and repeats it and puts my new table column to paste right next to it until data is sufficiently filled out

I have this

A	B	C	D
1	4	7	10
2	5	8	11
3	6	9	12

<tbody>
</tbody>

Regular Transposing gives me this

A	1	2	3
B	4	5	6
C	7	8	9
D	10	11	12

<tbody>
</tbody>

i want this

A	1
B	4
C	7
D	10
A	2
B	5
C	8
D	11
A	3
B	6
C	9
D	12

<tbody>
</tbody>

My table size will vary

Thank you!

 

[MickG]

Try this:-
Results start "H1"

[COLOR="Navy"]Sub[/COLOR] MG28Apr14
[COLOR="Navy"]Dim[/COLOR] Ray, nRay, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray = Range("A1").CurrentRegion
    ReDim nRay(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 2)
[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
    [COLOR="Navy"]For[/COLOR] Ac = 1 To UBound(Ray, 2)
        c = c + 1
        nRay(c, 1) = Ray(1, Ac)
        nRay(c, 2) = Ray(n, Ac)
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] n
Range("H1").Resize(c, 2) = nRay
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Snaybot]

Awesome Man!

Any way to paste this into a new Tab automatically?

 

[MickG]

Change the last line as below:-

sheets("Sheet2").Range("A1").Resize(c,2)= nray

 

[Snaybot]

doesnt seem to bee working

 

[Snaybot]

Sub MG28Apr14
Dim Ray, nRay, n As Long, c As Long, Ac As Long
Ray = Range("A1").CurrentRegion
ReDim nRay(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 2)
For n = 2 To UBound(Ray, 1)
For Ac = 1 To UBound(Ray, 2)
c = c + 1
nRay(c, 1) = Ray(1, Ac)
nRay(c, 2) = Ray(n, Ac)
Next Ac
Next n

sheets("Sheet2").Range("A1").Resize(c,2)= nrayEnd Sub</pre>

 

[Kinngs]

I've a Similar problem with an Addional condition.

I've This

Product No	TUV_Model	TUV_OverallLength	TUV_OverallWidth	TUV_OverallHeight	TUV_Wheelbase	TUV_EngineCapacity
Product 1	D1	4520mm	1850mm	1880mm	2760mm	2489
Product 2	D2	4520mm	1850mm	1880mm	2760mm	2489
Product 3	D3	4520mm	1850mm	1880mm	2760mm	2489

<tbody>
</tbody>

I Want This

Product 1	TUV_Model	D1
Product 1	TUV_OverallLength	4520mm
Product 1	TUV_OverallWidth	1850mm
Product 1	TUV_OverallHeight	1880mm
Product 1	TUV_Wheelbase	2760mm
Product 1	TUV_EngineCapacity	2489
Product 2	TUV_Model	D2
Product 2	TUV_OverallLength	4520mm
Product 2	TUV_OverallWidth	1850mm
Product 2	TUV_OverallHeight	1880mm
Product 2	TUV_Wheelbase	2760mm
Product 2	TUV_EngineCapacity	2489
Product 3	TUV_Model	D3
Product 3	TUV_OverallLength	4520mm
Product 3	TUV_OverallWidth	1850mm
Product 3	TUV_OverallHeight	1880mm
Product 3	TUV_Wheelbase	2760mm
Product 3	TUV_EngineCapacity	2489

<tbody>
</tbody>

In addition to the above query I Just have Want to repeat value in column 1

 

[MickG]

Have you got a sheet2 ??????

 

[MickG]

Kinngs:-
Try this for results on sheet2

[COLOR="Navy"]Sub[/COLOR] MG13Jun05
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
 Ray = 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"]For[/COLOR] Ac = 2 To UBound(Ray, 2)
        c = c + 1
        nray(c, 1) = Ray(n, 1)
        nray(c, 2) = Ray(1, Ac)
        nray(c, 3) = Ray(n, Ac)
     [COLOR="Navy"]Next[/COLOR] Ac
 [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

 

[Kinngs]

Thank You Mick, Superb!

Kinngs:-
Try this for results on sheet2

[COLOR=Navy]Sub[/COLOR] MG13Jun05
[COLOR=Navy]Dim[/COLOR] Ray [COLOR=Navy]As[/COLOR] Variant, c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Ac [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
 Ray = 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]For[/COLOR] Ac = 2 To UBound(Ray, 2)
        c = c + 1
        nray(c, 1) = Ray(n, 1)
        nray(c, 2) = Ray(1, Ac)
        nray(c, 3) = Ray(n, Ac)
     [COLOR=Navy]Next[/COLOR] Ac
 [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