collection monthly report for multiple files into one

Here's another option...
Change Path to Path housing files...

Sub J3v16()
Dim Temp, Dict As Object, File As Object, Path As String, TabName As String, i As Long
Set Dict = CreateObject("Scripting.Dictionary"): Path = "E:\Steven\Desktop\Test\"
With CreateObject("Scripting.FileSystemObject")
    For Each File In .GetFolder(Path).Files
        TabName = .GetBaseName(File)
        With Workbooks.Open(File)
            With .ActiveSheet.Range("A3:D" & .ActiveSheet.Cells(.ActiveSheet.Rows.Count, 4).End(xlUp).Row)
                Temp = Application.Index(.Value, Application.Evaluate("Row(1:" & .Rows.Count & ")"), Array(4, 3, 2, 1))
            End With
            .Close False
        End With
        With Sheets.Add
            .Name = Split(TabName, ".")(0)
            With .Range("A1").Resize(UBound(Temp, 1), 4)
                .Value = Temp
                FormatMe .CurrentRegion
            End With
        End With
        For i = 2 To UBound(Temp)
            If Not Dict.exists(Temp(i, 2)) Then
                Dict.Add Temp(i, 2), Temp(i, 3) & ";" & IIf(Temp(i, 4) = "", 0, Temp(i, 4))
            Else
                Dict(Temp(i, 2)) = Split(Dict(Temp(i, 2)), ";")(0) + Temp(i, 3) & ";" & Split(Dict(Temp(i, 2)), ";")(1) + Temp(i, 4)
            End If
        Next i
    Next File
End With
With Sheets("Year")
    .Activate
    .UsedRange.Delete
    .Range("A1").Resize(, 4) = Array("SN", "ITEM", "SALES", "RETURNS")
    .Range("B2").Resize(Dict.Count, 2) = Application.Transpose(Array(Dict.keys, Dict.items))
    .Range("C2").Resize(Dict.Count).TextToColumns .Range("C2"), xlDelimited, semicolon:=True
    With .Range("A2").Resize(Dict.Count): .Value = Evaluate("=Row(" & .Address & ")-1"): End With
    With .Range("A1:D1").Resize(Dict.Count + 1): FormatMe .CurrentRegion: End With
End With
End Sub