Transpose date from rows to columns for multiple rows using macro

[KD23]

Hi

I have a set of data i need to transpose hopefully with the use of a macro if possibly. Any other way would be helpful too but I dont really see how to get this done.

This is what my data looks like:

And this is what I want it to look like after:

Hopefully someone can help me.

Thank you

 

[maabadi]

Welcome to MrExcel Message Board.
You can do it with formula.
Select the exact range at source with rows (same as source colummns) and Reverse.
if your source has 5 rows and 3 columns, you should select 3 rows & 5 columns then Input (change to your Source or Select it):

=TRANSPOSE(B4:D21)

and Press CTRL+SHift+ENTER

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1
2						1	2	3	4	5	6	7	8	9
3						3	5	7	9	11	13	15	17	19
4		1	3	4		4	8	12	16	20	24	28	32	36
5		2	5	8
6		3	7	12
7		4	9	16
8		5	11	20
9		6	13	24
10		7	15	28
11		8	17	32
12		9	19	36
13
Sheet1

Cell Formulas
Range	Formula
F2:N4	F2	=TRANSPOSE(B4:D12)
Press CTRL+SHIFT+ENTER to enter array formulas.

 

[KD23]

Welcome to MrExcel Message Board.
You can do it with formula.
Select the exact range at source with rows (same as source colummns) and Reverse.
if your source has 5 rows and 3 columns, you should select 3 rows & 5 columns then Input (change to your Source or Select it):

=TRANSPOSE(B4:D21)

and Press CTRL+SHift+ENTER

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1
2						1	2	3	4	5	6	7	8	9
3						3	5	7	9	11	13	15	17	19
4		1	3	4		4	8	12	16	20	24	28	32	36
5		2	5	8
6		3	7	12
7		4	9	16
8		5	11	20
9		6	13	24
10		7	15	28
11		8	17	32
12		9	19	36
13
Sheet1

Cell Formulas
Range	Formula
F2:N4	F2	=TRANSPOSE(B4:D12)
Press CTRL+SHIFT+ENTER to enter array formulas.

Thank you for your response, but as you can see in my example, there are a few things that do not need to be transposed, so this method does not work.

 

[maabadi]

Try this Macro:

Sub TransformData()
Dim i As Long, Lr As Long, j As Long, Cell As Range, Lc As Long, L As Long, K1 As Long
Dim Lr2 As Long
Lr = Range("A" & Rows.Count).End(xlUp).Row
Lc = Cells(2, Columns.Count).End(xlToLeft).Column
Range("B" & Lr + 2).Value = "Project Type"
Range("C" & Lr + 2).Value = "Project #"
Range("D" & Lr + 2).Value = "Project Name"
Range("E" & Lr + 2).Value = "Date"
Range("F" & Lr + 2).Value = "Amount"
Lr2 = Lr + 3
For i = 3 To Lr
L = 0
K1 = Application.WorksheetFunction.Count(Range(Cells(i, 5), Cells(i, Lc))) - 1
Range("B" & Lr2 & ":B" & Lr2 + K1).Value = Range("C" & i).Value
Range("C" & Lr2 & ":C" & Lr2 + K1).Value = Range("B" & i).Value
Range("D" & Lr2 & ":D" & Lr2 + K1).Value = Range("A" & i).Value
For j = 5 To Lc
If Cells(i, j).Value = "" Then
Else
Range("E" & Lr2 + L).Value = Cells(2, j).Value
Range("F" & Lr2 + L).Value = Cells(i, j).Value
L = L + 1
End If
Next j
Lr2 = Range("B" & Rows.Count).End(xlUp).Row + 1
Next i

End Sub