Creating a macro that properly filters data and puts it on another sheet - vba

Question

I have a large dataset that is ordered in a weird way, as in the picture:
This is how my data looks currently
This is what i want it to be like
So mainly I want to do 2 things, first i want to cut the two other columns that display data, and paste them underneath the first column, but only for the first weeks period, and then sort the data, macro recording doesn't work very well since weeks are really months, therefore the amount of days changes per month, hence the height of each column.
My idea is to use a while loop to scroll through the first column (the first one displaying "Day", for each non-number entry (say the first no-greater than zero input), and then cut the whole three block array and paste it somewhere else, say a new sheet called Week "n", given it's the n'th week.
Then properly order this array, copying the two right blocks underneath the first one, and sort them by day and hour.
This I want to do for each data period of a week, but I'm not that well versed on vba's syntax to achieve this, mostly i do not know how to order the array the way im looking to once they are copied to new sheets, neither do i know how to do it if i were not to add new sheets and instead reformat it in place.
Any help is welcome.

Answer 1

Considering your data is set up as per the following image...
Place the following code on a Standard Module like Module1...
Sub TransformWeekData()
Dim sws As Worksheet, dws As Worksheet
Dim lr As Long, dlr As Long, i As Long
Dim Rng As Range
Application.ScreenUpdating = False
Set sws = Sheets("Sheet1") 'Source data sheet
lr = sws.Cells(Rows.Count, 1).End(xlUp).Row
On Error Resume Next
Set dws = Sheets("Combined Data") 'Output Sheet
dws.Cells.Clear
On Error GoTo 0
If dws Is Nothing Then
Set dws = Sheets.Add(after:=sws)
dws.Name = "Combined Data"
End If
On Error Resume Next
For Each Rng In sws.Range("A2:A" & lr).SpecialCells(xlCellTypeConstants, 1).Areas
If dws.Range("A1").Value = "" Then
dlr = 1
Else
dlr = dws.Range("A" & Rows.Count).End(3)(2).Row
End If
dws.Range("A" & dlr).Value = Rng.Cells(1).Offset(-2, 0).Value
dws.Range("A" & dlr + 1 & ":C" & dlr + 1).Value = Array("Day", "Amount", "Hour")
For i = 1 To 9 Step 3
dlr = dws.Range("A" & Rows.Count).End(3)(2).Row
Rng.Offset(, i - 1).Resize(Rng.Cells.Count, 3).Copy dws.Range("A" & dlr)
Next i
Next Rng
dlr = dws.Range("A" & Rows.Count).End(xlUp).Row
For Each Rng In dws.Range("A2:A" & dlr).SpecialCells(xlCellTypeConstants, 1).Areas
Rng.Resize(Rng.Cells.Count, 3).Sort key1:=Rng.Cells(1), order1:=xlAscending, key2:=Rng.Cells(1, 3), order2:=xlAscending, Header:=xlNo
Next Rng
Application.ScreenUpdating = True
End Sub
The code above will insert a sheet called Combined Data if doesn't exist in the workbook with the data in the desired format as shown in the image below...
You may change the output sheet's name as per your requirement.