[VBA] Préservation formules existantes (+identification adresse cellules)

Sub test()
    Dim ligDeb As Long, nblig As Long
    ligDeb = 1: lot = Cells(ligDeb, 1)
    For ligDeb = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        nblig = Application.CountIf(Columns(1), Cells(ligDeb, 1)) ' taille
        Cells(ligDeb, 3).Resize(nblig).Formula = "=Min(" & Cells(ligDeb, 2).Resize(nblig).Address & ")+" & Cells(ligDeb, 2).Address(False, True) ' formule bidon
        ligDeb = ligDeb + nblig - 1
    Next ligDeb
End Sub

Sub test_ok()
Dim ligDeb&, nblig&
ligDeb = 3: lot = Cells(ligDeb, 3)
For ligDeb = 3 To Cells(Rows.Count, 1).End(xlUp).Row
nblig = Application.CountIf(Columns(1), Cells(ligDeb, 1))
Cells(ligDeb, "U").Formula = "=MIN(" & Cells(ligDeb, "T").Resize(nblig).Address & ")"
ligDeb = ligDeb + nblig - 1
Next ligDeb
End Sub

Sub ReconstruireFormules()
Dim ColA As Range, i&, n&, zoneA&(), celBaseF1, plageF1 As Range, plageF2 As Range, plageF3 As Range, deb&, fin&
Set ColA = Range("A3", Range("A" & Rows.Count).End(xlUp))
If ColA.Row < 3 Then Exit Sub 'si tableau vide
Application.ScreenUpdating = False
ColA.EntireRow.Sort ColA, xlAscending, Header:=xlNo 'tri de sécurité
'---lignes de début et de fin de zones en colonne A---
For i = 1 To ColA.Count
    If ColA(i) <> ColA(i - 1) Then
        n = n + 1
        ReDim Preserve zoneA(1 To 2, 1 To n)
        zoneA(1, n) = i
    End If
    zoneA(2, n) = i
Next
'---initialisation des cellules de base et des plages des formules---
celBaseF1 = Array("H3", "J3", "L3", "N3", "P3") 'adresses (sans signe $)
Set plageF1 = Intersect(ColA.EntireRow, [T:T]).Offset(, -5)
Set plageF2 = Intersect(ColA.EntireRow, [U:U]).Offset(, -5)
Set plageF3 = Intersect(ColA.EntireRow, [V:V]).Offset(, -5)
'---formules F1 F2 F3---
For i = 1 To 5
    Set plageF1 = plageF1.Offset(, 5)
    Set plageF2 = plageF2.Offset(, 5): plageF2 = ""
    Set plageF3 = plageF3.Offset(, 5)
    plageF1 = "=" & celBaseF1(i - 1) & "*" & plageF1(1, -1).Address(0, 0) & "+2*" & plageF1(1, 0).Address(0, 0)
    For n = 1 To UBound(zoneA, 2)
        deb = zoneA(1, n): fin = zoneA(2, n)
        plageF2(deb) = "=MIN(" & plageF1(deb).Address(0, 0) & ":" & plageF1(fin).Address(0, 0) & ")"
        plageF3(deb).Resize(fin - deb + 1) = "=13*" & plageF2(deb).Address(1, 0) & "/" & plageF1(deb).Address(0, 0)
Next n, i
'---dernières formules---
Intersect(ColA.EntireRow, [AQ:AQ]) = "=AVERAGE(V3,AA3,AF3,AK3,AP3)"
Intersect(ColA.EntireRow, [AV:AV]) = "=SUM(AQ3:AU3)"
End Sub

Sub insert_formules()
datas
Dim a As Range, b As Range, c As Range
For Each a In [A1:A15].SpecialCells(xlCellTypeBlanks).Areas
    a = a(0)
MsgBox "valeur de a: " & a.Address 'pour test
    Set b = Intersect(Union(a(0), a).EntireRow, Columns("B"))
    Set c = Intersect(a(0).EntireRow, Columns("D"))
    c = "=MIN(" & b.Address(0, 0) & ")"
MsgBox "valeur de b(1): " & b(1).Address(0, 0) ' pour test
    Intersect(b.EntireRow, Columns("F")) = "=" & b(1).Address(0, 0) & "/" & c.Address(1, 0)
Next
End Sub

Application.ScreenUpdating = False
ColA.EntireRow.Sort ColA, xlAscending, Header:=xlNo 'tri de sécurité
On Error Resume Next 'si aucune SpecialCell
ColA.SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'vides
ColA.SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete 'textes
On Error GoTo 0

Sub datas_Test()
Cells.Clear
[A3:A5] = 1: [A6:A9] = 2: [A10:A14] = 3: [A15:A20] = 4
[B3:B20].FormulaLocal = "=CAR(64+A3)&LIGNE()"
[D3:D20] = "=(1600*(ROW()-2))/40"
With ActiveSheet.UsedRange
.Value = .Value
End With
ReconstruireFormules
End Sub
Sub AlterationParLusagerTemeraire()
Rows("15:17").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
[A18] = "INTITULE1": [A18].AutoFill Range("A18:D18"), 0
ReconstruireFormules
End Sub

Sub test_Arrays_Formules()
Dim x&, i&, t(), c As Range
Cells.Clear
[A1] = "=TODAY()": [C3] = "=ROW()": [E5] = "=COLUMN()": [H7] = "=PI()"
x = ActiveSheet.UsedRange.SpecialCells(-4123, 23).Count
ReDim t(1 To x, 2): i = 1
For Each c In ActiveSheet.UsedRange.SpecialCells(-4123, 23)
t(i, 1) = c.Address: t(i, 2) = c.Formula
test = test & t(i, 1) & "|" & t(i, 2) & Chr(13)
i = i + 1
Next
Cells.Clear
MsgBox test
For j = LBound(t, 1) To UBound(t, 1)
Range(t(j, 1)).Formula = t(j, 2)
Next
End Sub