VBA Transpose rows to columns

[Skovgaard]

Hi All,

I've been searching the forum, but haven't been able to find exactly what I need.

I need a macro that gives below result, hope anyone can help.

Data:
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD]Jan[/TD]
[TD]Feb[/TD]
[TD]Mar[/TD]
[/TR]
[TR]
[TD]P1[/TD]
[TD]Q1[/TD]
[TD]75[/TD]
[TD]100[/TD]
[TD]125[/TD]
[/TR]
[TR]
[TD]P2[/TD]
[TD]Q2[/TD]
[TD]30[/TD]
[TD]40[/TD]
[TD]50[/TD]
[/TR]
[TR]
[TD]P3[/TD]
[TD]Q2[/TD]
[TD]10[/TD]
[TD]40[/TD]
[TD]70[/TD]
[/TR]
</tbody>[/TABLE]

Result:

[TABLE="width: 500"]
<tbody>[TR]
[TD]P1[/TD]
[TD]Q1[/TD]
[TD]Jan[/TD]
[TD]75[/TD]
[/TR]
[TR]
[TD]P1[/TD]
[TD]Q1[/TD]
[TD]Feb[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]P1[/TD]
[TD]Q1[/TD]
[TD]Mar[/TD]
[TD]125[/TD]
[/TR]
[TR]
[TD]P2[/TD]
[TD]Q2[/TD]
[TD]Jan[/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]P2[/TD]
[TD]Q2[/TD]
[TD]Feb[/TD]
[TD]40[/TD]
[/TR]
[TR]
[TD]P2[/TD]
[TD]Q2[/TD]
[TD]Mar[/TD]
[TD]50[/TD]
[/TR]
[TR]
[TD]P3[/TD]
[TD]Q2[/TD]
[TD]Jan[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]P3[/TD]
[TD]Q2[/TD]
[TD]Feb[/TD]
[TD]40[/TD]
[/TR]
[TR]
[TD]P3[/TD]
[TD]Q2[/TD]
[TD]Mar[/TD]
[TD]70[/TD]
[/TR]
</tbody>[/TABLE]
Regards
Skovgaard

 

[SyedUsman]

Use power query & paste the code in advance editor

let
Source = Excel.CurrentWorkbook(){[Name="Table2"]}[Content],
#"Changed Type" = Table.TransformColumnTypes(Source,{{"Column1", type text}, {"Column2", type text}, {"Jan", Int64.Type}, {"Feb", Int64.Type}, {"Mar", Int64.Type}}),
#"Unpivoted Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"Column1", "Column2"}, "Attribute", "Value")
in
#"Unpivoted Columns"

 

[Peter_SSs]

For data in A1:E4 as shown below, the following code produced the results in row 7 and below. Is that what you want?

Sub Rearrange()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  
  a = Range("A1").CurrentRegion.Value
  ReDim b(1 To UBound(a, 1) * (UBound(a, 2) - 2), 1 To 4)
  For i = 2 To UBound(a, 1)
    For j = 3 To UBound(a, 2)
      k = k + 1
      b(k, 1) = a(i, 1): b(k, 2) = a(i, 2): b(k, 3) = a(1, j): b(k, 4) = a(i, j)
    Next j
  Next i
  Range("A" & Rows.Count).End(xlUp).Offset(3).Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

Excel Workbook
	A	B	C	D	E	F
1			Jan	Feb	Mar
2	P1	Q1	75	100	125
3	P2	Q2	30	40	50
4	P3	Q2	10	40	70
5
6
7	P1	Q1	Jan	75
8	P1	Q1	Feb	100
9	P1	Q1	Mar	125
10	P2	Q2	Jan	30
11	P2	Q2	Feb	40
12	P2	Q2	Mar	50
13	P3	Q2	Jan	10
14	P3	Q2	Feb	40
15	P3	Q2	Mar	70
16
Rearrange

 

[Skovgaard]

Exactly what I needed, Thanks Peter!

 

[Peter_SSs]

Exactly what I needed, Thanks Peter!

You are very welcome.

 

[scwkwong]

hi, that's very useful macro. How about the vice versa? I have the multiple rows of data and want to transpose to the multiple columns. Would you please help? Thanks, Stan

A Col1 1
A Col2 2
A Col3 3
A Col4 4
B

Col1 1​

B

Col2 2​

B

Col3 3​

B

Col4 5

want to transpose like below:
Col1 Col2 Col3 Col4
A 1 2 3 4
B 1 2 3 5

Thanks.​