VBA Transpose Rows to Columns and Fill in Black Cells for Days Without Data

[lstod]

I would really appreciate assistance with reviewing my code. I am fairly new to VBA and can't seem to figure out the correct procedure to clean up/reformat the data on a spreadsheet.

I have a spreadsheet with sheets for each year from last year to 10 years in the future. Within each sheet the data is broken down by day horizontally; however the dates are not hard coded they merely a number between 1-31.

I need to get the Total Count by Day rows for each month beginning January of the current year +1 year out transposed vertically onto a different sheet "Compiled" that lists the date in column "A" and the Total Count in Column "B" and fill in zeros for any dates with no data.

Problems I've noticed with my code
1. Need a way to determine what the current year is in order to select the correct sheet and start at the correct date on the "Compiled" sheet.
2. Number of days varies month to month and year over year (leap year), which causes the data when pasted vertically to be offset into the wrong date on the "Compiled" sheet.
3. December typically has no data during the last few days of the month, which causes another offset issue when the loop starts to pull next years data.

Excel 2010

	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AI	AJ	AK
161	November 2018				Thu	Fri	Sat	Sun	Mon	Tue	Wed	Thu	Fri	Sat	Sun	Mon	Tue	Wed	Thu	Fri	Sat	Sun	Mon	Tue	Wed	Thu	Fri	Sat	Sun	Mon	Tue	Wed	Thu	Fri
162					1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30
163
164					1100	4400	9500	10000	10000	9200	7100	1900	400	100
165
166											45	270	1395	3285	4500	4500	3825	1305
167
168														24	50	183	956	1750	1750	1750	600	30
169
170																															138	700	6825	13125
171	TOTAL COUNT BY DAY				1100	4400	9500	10000	10000	9200	7145	2170	1795	3409	4550	4683	4781	3055	1750	1750	600	30									138	700	6825	13125
172																																	100706
173
174	December 2018				Sat	Sun	Mon	Tue	Wed	Thu	Fri	Sat	Sun	Mon	Tue	Wed	Thu	Fri	Sat	Sun	Mon	Tue	Wed	Thu	Fri	Sat	Sun	Mon	Tue	Wed	Thu	Fri	Sat	Sun	Mon
175					1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30	31
176
177					17500	13300	11375	1925	350
178
179								30	60	210	1530	2910	3000	3000	2610	600	60
180	TOTAL COUNT BY DAY				17500	13300	11375	1955	410	210	1530	2910	3000	3000	2610	600	60					0
181																																		58460

<tbody>
</tbody>

2018​

Sub CleanRUR()
Dim x As Long
    Dim i As Long
    Dim z As Range
    Dim y As Long
    Dim LastRow As Long
    Dim LRow As Long
    Dim StartDate As Date
    Dim EndDate As Date
    Dim NoDays As Integer
    
    'Add sheet and fill date down for two years
    Sheets.Add.Name = "Compiled"
    Sheets("Compiled").Range("a2") = (#1/1/2017#)
    Range("A2:A732").DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:=xlDay, Step:=1, Trend:=False
    Cells(1, 1).Value = [{"Date"}]
    Cells(1, 2) = [{"Product"}]
    Columns("A:B").EntireColumn.AutoFit
    
    'Loop through first two sheets in workbook to consolidate monthly totals
    For y = 3 To 4
        If y = 3 Then
            Sheets(y).Activate
            Cells(1, 1).Select
            LastRow = Cells(Rows.Count, 2).End(xlUp).Row
            For x = LastRow To 1 Step -1
                If Cells(x, 2).Value <> "TOTAL COUNT BY DAY" Then
                Rows(x).Delete
                End If
            Next x
    
            Columns("A:E").Delete
            Cells(1, 1).Select
    
            LRow = Cells(Rows.Count, 1).End(xlUp).Row
        
            'Copy rows and transpose vertically onto Compile ws
            For i = 1 To LRow Step 1
                Rows(i).Copy
                Sheets("Compiled").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
            Next i
            
            'Fills in zero for blank cells
            With Sheets("Compiled")
                .Range("B2:B367").SpecialCells(xlCellTypeBlanks).Value = "0"
            End With
        Else
            Sheets(y).Activate
            Cells(1, 1).Select
            LastRow = Cells(Rows.Count, 2).End(xlUp).Row
            For x = LastRow To 1 Step -1
                If Cells(x, 2).Value <> "TOTAL COUNT BY DAY" Then
                Rows(x).Delete
                End If
            Next x
    
            Columns("A:E").Delete
            Cells(1, 1).Select
    
            LRow = Cells(Rows.Count, 1).End(xlUp).Row
        
            'Copy rows and transpose vertically onto Compile ws
            For i = 1 To LRow Step 1
                Rows(i).Copy
                Sheets("Compiled").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
            Next i
            
            'Fills in zero for blank cells
            With Sheets("Compiled")
                .Range("B368:B732").SpecialCells(xlCellTypeBlanks).Value = "0"
            End With
        End If
    Next y
    
    Sheets("Compiled").Activate

End Sub