Résumer plusieurs formules dans une seule cellule

Sub SubRefInFormula()

'Substitute into a formula the references with the formulas written in those references.

Dim xCol As String, xLig As String, xRef As String
Dim xFor1 As String, xFor2 As String
Dim Xsource As Range, xSub As Range, xDest As Range
Dim IsArray As Boolean

On Error GoTo FIN
    ' Selection of the initial formula
    Set Xsource = Application.InputBox(Title:="Initial cell...", _
                                                prompt:=" Select the cell containing the initial formula :?", _
                                                Type:=8)
    xFor1 = Xsource.FormulaLocal
    IsArray = Xsource.HasArray
    
    ' Selection of the destination cell (could be the same ==> dangerous !)
    Set xDest = Application.InputBox(Title:="Destination cell...", _
                                                prompt:=" Select the cell that will contain the final formula :?", _
                                                Type:=8)

AutreSubstitution:
    'Loop until user clicks on 'Cancel' in the dialog box
    Set xSub = Application.InputBox(Title:="Cell containing a formula", _
         prompt:=" Select a cell with a formula to insert into the final formula :?" & _
         vbLf & " - Cancel when no more replacement -", _
         Type:=8)
    If Not xSub.HasFormula Then GoTo AutreSubstitution
    ' The result formula may be an array formula or not
    IsArray = IsArray Or xSub.HasArray
    ' Delete the sign "=" at the beginning of the formula
    xFor2 = xSub.FormulaLocal
    If Left(xFor2, 1) = "=" Then xFor2 = Right(xFor2, Len(xFor2) - 1)
    ' Get the row number and the column letters.
    xCol = xSub.Address(True, False, xlA1)
    xCol = Left(xCol, InStr(xCol, "$") - 1)
    xLig = xSub.Address(True, False, xlA1)
    xLig = Right(xLig, Len(xLig) - InStr(xLig, "$"))
     ' replace the string like $A1
    xRef = "$" & xCol & xLig
    xFor1 = Replace(xFor1, xRef, "(" & xFor2 & ")")
     ' replace the string like A$1
    xRef = xCol & "$" & xLig
    xFor1 = Replace(xFor1, xRef, "(" & xFor2 & ")")
     ' replace the string like $A$1
    xRef = "$" & xCol & "$" & xLig
    xFor1 = Replace(xFor1, xRef, "(" & xFor2 & ")")
     ' replace the string like A1
    xRef = xCol & xLig
    xFor1 = Replace(xFor1, xRef, "(" & xFor2 & ")")
    ' insert the new formula into the destination cell
    xDest.FormulaLocal = xFor1
    
GoTo AutreSubstitution

FIN:
    xDest.Select
    ' If Dest has a formula and if Dest might have an ARRAy formula
    If xDest.HasFormula And IsArray Then
        MsgBox "The result formula is certainly an array formula." & vbCrLf & vbCrLf & _
        "Do not forget to validate it with Ctrl+Shift+Enter !"
        ' Edit the Dest formula so the user can immediately validate the formula
        ' with Ctrl+Shift+Enter if he want the dest formula to be an array formula.
        Application.SendKeys ("{F2}")
    End If
End Sub

Function TheFormulaLocal(xRG As Range) As String
    TheFormulaLocal = xRG.FormulaLocal
End Function

Function TheFormula(xRG As Range) As String
    TheFormula = xRG.Formula
End Function