Sub СобратьФайлы()
    ThisWorkbook.Save
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    Dim sh As Worksheet
    Dim cl As Range
    Dim cs As Range
    Dim sFileName As String
    
    
    For Each sh In ThisWorkbook.Worksheets
        For Each cl In sh.UsedRange.Cells
            With cl
                If .Interior.Color = 13434879 Then
                    .ClearContents
                End If
            End With
        Next
    Next
    
    sFileName = Dir(ThisWorkbook.Path & "\*.xl*")
    
    Do While sFileName <> ""
        If sFileName <> ThisWorkbook.Name Then
            Workbooks.Open ThisWorkbook.Path & "\" & sFileName
            Application.Calculate
            
            For Each sh In ThisWorkbook.Worksheets
                For Each cl In sh.UsedRange.Cells
                    With cl
                        If .Interior.Color = 13434879 Then
                            
                            Set cs = Workbooks(sFileName).Sheets(.Parent.Name).Range(.Address)
                            
                            Select Case .Parent.Name
                            Case "Титул"
                                .Value = cs.Value
                            Case Else
                                If IsNumeric(cs.Value) Then .Value = .Value + cs.Value
                            End Select
                        End If
                    End With
                Next
            Next
            
            Workbooks(sFileName).Close False
        End If
        
        sFileName = Dir
    Loop

    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With


End Sub