Row to Column in Excel - excel

Question

I have a set of data in this format:-
Note: It starts from Jan-17 to Dec-17. However, for this exercise I limit it to 3 months (Jan to Mar).
I wish to convert the data into this format:-
How can i achieve it using Excel?
Thanks in advance.

Answer 1

How about something like below, using a double For Loop to loop through rows and then columns and transfer data to Sheet2 in the desired format (this won't add the headers to Sheet2, but it will give you a some guidance as to how to go about it):
Sub Summarize()
Dim ws As Worksheet: Set ws = Sheets("Sheet1") 'Sheet with data
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2") 'Summarised Sheet
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
For i = 2 To LastRow 'loop through rows
For col = 6 To 14 Step 4 'loop through columns
'replace 14 with (LastCol - 4) if you wish to do all the months instead of just the first 3
FreeRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1 'get the next free row to transfer data to
ws.Range("A" & i & ":D" & i).Copy ws2.Range("A" & FreeRow) 'copy the first 4 columns into the free row
ws2.Cells(FreeRow, 5).Value = "20" & Mid(ws.Cells(1, col).Value, 5, 2) 'get the year from the header
ws2.Cells(FreeRow, 6).Value = Left(ws.Cells(1, col).Value, 3) ' get the month name from header
ws2.Cells(FreeRow, 7).Value = ws.Cells(i, col).Value 'transfer values
ws2.Cells(FreeRow, 8).Value = ws.Cells(i, col + 1).Value
ws2.Cells(FreeRow, 9).Value = ws.Cells(i, col + 2).Value
ws2.Cells(FreeRow, 10).Value = ws.Cells(i, col + 3).Value
Next col
Next i
End Sub
UPDATE:
I've added a couple of lines to the code to attempt to optimize the speed of it, also removed the Copy & Paste and altered it to pass the values without copying anything, please have a look below:
Sub Summarize()
Dim ws As Worksheet: Set ws = Sheets("Sheet1") 'Sheet with data
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2") 'Summarised Sheet
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
'optimize code:
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
For i = 2 To LastRow 'loop through rows
For col = 6 To 14 Step 4 'loop through columns
'replace 14 with (LastCol - 4) if you wish to do all the months instead of just the first 3
FreeRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1 'get the next free row to transfer data to
ws2.Cells(FreeRow, 1).Value = ws.Cells(i, 1).Value
ws2.Cells(FreeRow, 2).Value = ws.Cells(i, 2).Value
ws2.Cells(FreeRow, 3).Value = ws.Cells(i, 3).Value
ws2.Cells(FreeRow, 4).Value = ws.Cells(i, 4).Value
ws2.Cells(FreeRow, 5).Value = "20" & Mid(ws.Cells(1, col).Value, 5, 2) 'get the year from the header
ws2.Cells(FreeRow, 6).Value = Left(ws.Cells(1, col).Value, 3) ' get the month name from header
ws2.Cells(FreeRow, 7).Value = ws.Cells(i, col).Value 'transfer values
ws2.Cells(FreeRow, 8).Value = ws.Cells(i, col + 1).Value
ws2.Cells(FreeRow, 9).Value = ws.Cells(i, col + 2).Value
ws2.Cells(FreeRow, 10).Value = ws.Cells(i, col + 3).Value
Next col
Next i
'return to normal Excel status after macro has finished
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub