'Procedure sort sheets with 4 digit names like 1990, 2015 and etc.
'Then, it creates a sheet named "Merge" with a header. The header is a copy of header from CEIP report.
'And finally, it copies data from sheets year by year.

Sub MainMergeSheets()

    Dim shColl As New Collection
    Dim yearNum
    Dim NUM_COPIED_ROWS As Single
    Dim min4DigitName As Integer
    'Number of rows copied from every sheets
    NUM_COPIED_ROWS = 128
    
    'Speed up macro by disable screen updating
    Application.ScreenUpdating = False
    
    'Sort sheets with 4 digit name
    SortSheetsTabName
    'First sheet with 4 digit name is the lowest after SortSheetsTabName procedure
    min4DigitName = First4DigitSheetName
    'Create the Merge sheet and add header
    CreateMergeSheet
    
    For Each sh In ActiveWorkbook.Sheets
        If (sh.name Like "####") Then
            shColl.Add sh, sh.name
        End If
    Next sh
    
    'Merge specific cells from other sheet to "Merge" sheets
    For Each sh In shColl
        yearNum = sh.name - min4DigitName + 1
        sh.Range("A14:AL141").Copy
        Sheets("Merge").Range("B" & 5 + ((yearNum - 1) * NUM_COPIED_ROWS) & ":AL" & 2 + (yearNum * NUM_COPIED_ROWS)).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        With Sheets("Merge").Range("A" & 5 + ((yearNum - 1) * NUM_COPIED_ROWS) & ":A" & 4 + (yearNum * NUM_COPIED_ROWS))
            .NumberFormat = "General"
            .Value = sh.name
        End With
    Next sh
    
    'Application.ScreenUpdating turn on
    Application.ScreenUpdating = True
    
    'Select first row at the bottom to show last result
    Sheets("Merge").Range("A" & (shColl.Count * NUM_COPIED_ROWS) + 5).Select
End Sub
Private Sub SortSheetsTabName()
    Dim iSheets%, i%, j%
    iSheets = Sheets.Count
    For i = 1 To iSheets - 1
        For j = i + 1 To iSheets
            If Sheets(j).name < Sheets(i).name Then
                If Sheets(i).name Like "####" Then
                    Sheets(j).Move Before:=Sheets(i)
                End If
            End If
        Next j
    Next i
End Sub
Private Function First4DigitSheetName() As Integer
    Dim i%
    For i = 1 To Sheets.Count
        If Sheets(i).name Like "####" Then
            First4DigitSheetName = CInt(Sheets(i).name)
            Exit Function
        End If
    Next i
End Function
Private Sub CreateMergeSheet()
    Dim i%
    For i = 1 To Sheets.Count
        If Sheets(i).name = "Merge" Then
            Application.DisplayAlerts = False
            Sheets(i).Delete
            Application.DisplayAlerts = True
            Exit For
        End If
    Next i
    Sheets.Add(Before:=Sheets(1)).name = "Merge"
    Sheets(CStr(First4DigitSheetName)).Range("A10:AL13").Copy
    Sheets("Merge").Range("B1").PasteSpecial Paste:=xlPasteValues
    Sheets("Merge").Range("B5").Activate
    ActiveWindow.FreezePanes = True
End Sub