Option Explicit
Private Const SVOD_NAME = "Свод"
Private Const STAT_FIRST_CELL = "A2"
Private Const REGN_FIRST_CELL = "C1"

Private wb As Workbook
Private stat As Range
Private regn As Range
Private svod As Range
Private aStat As Variant
Private aRegn As Variant
Private aSvod As Variant

Sub Сформировать_свод()
    
    InitParams
    FillSvodArray
    EditSvodArray
    PrintSvodArray

End Sub

Private Sub InitParams()
    
    Set wb = ActiveWorkbook
    Dim shSvod As Worksheet
    Set shSvod = wb.Sheets(SVOD_NAME)
    
    With shSvod
        Dim ii As Long
        
        Set stat = .Range(STAT_FIRST_CELL)
        ii = .Cells(.Rows.Count, stat.Column).End(xlUp).Row
        If ii < stat.Row Then Exit Sub
        Set stat = .Range(stat, .Cells(ii, stat.Column))
                
        Set regn = .Range(REGN_FIRST_CELL)
        ii = .Cells(regn.Row, .Columns.Count).End(xlToLeft).Column
        If ii < regn.Column Then Exit Sub
        Set regn = .Range(regn, .Cells(regn.Row, ii))
        
        Set svod = Intersect(stat.EntireRow, regn.EntireColumn)
        
        aStat = stat.Value
        aRegn = regn.Value
        ReDim aSvod(1 To svod.Rows.Count, 1 To svod.Columns.Count)
        
    End With
End Sub

Private Sub FillSvodArray()
    Dim sh As Worksheet
    For Each sh In wb.Worksheets
        If IsProjectSheet(sh) Then
            FillFromProjectSheet sh
        End If
    Next
End Sub

Private Sub FillFromProjectSheet(sh As Worksheet)
    Dim regnFrom As Range
    Dim statFrom As Range
    On Error Resume Next
    Set regnFrom = sh.Cells.Find("Регион")
    Set statFrom = sh.Cells.Find(aStat(1, 1))
    On Error GoTo 0
    If regnFrom Is Nothing Then Exit Sub
    If statFrom Is Nothing Then Exit Sub
    Dim xf As Long
    Dim xt As Long
    With sh
        Dim sh_Name  As String
        sh_Name = sh.Name
    
        xf = .Cells(regnFrom.Row, .Columns.Count).End(xlToLeft).Column
        If xf <= regnFrom.Column Then Exit Sub
        Set regnFrom = .Range(regnFrom.Cells(1, 2), .Cells(regnFrom.Row, xf))
    End With

    Dim dx As Long
    Dim dy As Long
    dx = regnFrom.Column - regn.Column
    dy = statFrom.Row - stat.Row
    
    Dim aRegnFrom As Variant
    aRegnFrom = GetArrayFromRange(regnFrom)
    
    For xf = 1 To UBound(aRegnFrom, 2)
        For xt = 1 To UBound(aRegn, 2)
            If aRegnFrom(1, xf) = aRegn(1, xt) Then
                aSvod(1, xt) = aSvod(1, xt) & "+'" & sh_Name & "'!R[" & dy & "]C[" & xf - xt + dx & "]"
            End If
        Next
    Next
    
End Sub

Private Sub EditSvodArray()
    Dim ya As Long
    Dim xa As Long
        For xa = 1 To UBound(aSvod, 2)
            If Not IsEmpty(aSvod(1, xa)) Then
                If Left(aSvod(1, xa), 1) = "+" Then aSvod(1, xa) = Mid(aSvod(1, xa), 2, Len(aSvod(1, xa)))
                aSvod(1, xa) = "=" & aSvod(1, xa)
                For ya = 2 To UBound(aSvod, 1)
                    aSvod(ya, xa) = aSvod(1, xa)
                Next
            End If
        Next
End Sub

Private Sub PrintSvodArray()
    svod.Value = aSvod
End Sub

Private Function GetArrayFromRange(rr As Range) As Variant
    Dim arr As Variant
    If rr.Cells.CountLarge = 1 Then
        ReDim arr(1 To 1, 1 To 1)
        arr(1, 1) = rr.Value
    Else
        arr = rr.Value
    End If
    GetArrayFromRange = arr
End Function

Private Function IsProjectSheet(sh As Worksheet) As Boolean
    If sh.Range("A2").Value = "Регион" Then IsProjectSheet = True
End Function