Private Sub CommandButton1_Click()
Dim ncol%, nlig&, t, nlig1&, P As Range, d As Object, i&, P1 As Range, x$, j&
ncol = 46 'nombre de colonnes du tableau, la colonne A est masquée
Application.ScreenUpdating = False
With Workbooks.Open(ThisWorkbook.Path & "\Matrice.xlsx").Sheets("MNT")
.[A:A].Insert 'ajout d'une colonne
nlig = .Range("D" & .Rows.Count).End(xlUp).Row
If nlig > 1 Then nlig = nlig - 1
.[A2].Resize(nlig) = .[D2].Resize(nlig).Value '"Hiérarchie OTP" copié en colonne A
.[F2].Resize(nlig) = "=RC[4]-RC[7]-(RC[40]+RC[31]+RC[18])"
.[N2].Resize(nlig) = "=RC[-4]-RC[-1]"
.[O2].Resize(nlig) = "=RC[-2]+(RC[9]+RC[22]+RC[31])"
.[P2].Resize(nlig) = "=IFERROR(RC[-3]/RC[-1],"""")"
.[X2].Resize(nlig) = "=SUM(RC[-5]:RC[-1])"
.[AK2].Resize(nlig) = "=SUM(RC[-12]:RC[-1])"
.[AT2].Resize(nlig) = "=SUM(RC[-8]:RC[-1])"
t = .[A2].Resize(nlig, ncol).FormulaR1C1
.Parent.Close False
End With
'---restitution des valeurs et formules du 1er tableau---
nlig1 = Range("D" & Rows.Count).End(xlUp).Row + 2
With [A3].Resize(nlig1, ncol)
.Borders.LineStyle = xlNone 'supprime les bordures
.Copy [A3].Offset(, ncol) 'sauvegarde TOUT le tableau vers la droite
.Delete xlUp 'RAZ
End With
Set P = [A3].Resize(nlig, ncol)
P = t
'---liste des "Hiérarchie OTP" du 1er tableau (sans doublon)---
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To nlig
If t(i, 1) <> "" Then d(t(i, 1)) = i 'repère la ligne
Next i
'---copie les lignes du 2ème tableau vers le 1er---
Set P1 = [A3].Offset(, ncol).Resize(nlig1, ncol)
For i = 1 To nlig1
x = IIf(P1(i, 1) = "", P1(i, "D"), P1(i, 1)) '"Hiérarchie OTP" d'origine
If x <> "" And d.Exists(x) Then
j = d(x)
Union(P(j, 1), P(j, "D")) = P1(i, "D") '"Hiérarchie OTP" modifiées
P(j, "F") = P1(i, "F").FormulaR1C1
P(j, "N") = P1(i, "N").FormulaR1C1
P(j, "O") = P1(i, "O").FormulaR1C1
P(j, "P") = P1(i, "P").FormulaR1C1
P(j, "X") = P1(i, "X").FormulaR1C1
P(j, "AK") = P1(i, "AK").FormulaR1C1
P(j, "AT") = P1(i, "AT").FormulaR1C1
P1.Rows(i).Copy
P(j, 1).PasteSpecial xlPasteFormats 'copie les couleurs
End If
Next i
P1.EntireColumn.Delete 'RAZ
'---bordures---
P.Borders(xlEdgeLeft).Weight = xlThin
P.Borders(xlEdgeTop).Weight = xlThin
P.Borders(xlEdgeRight).Weight = xlThin
P.Borders(xlEdgeBottom).Weight = xlMedium 'pourquoi pas...
P.Borders(xlInsideVertical).Weight = xlThin
P.Borders(xlInsideHorizontal).Weight = xlHairline
'---actualise les barres de défilement---
With Me.UsedRange: End With
[B1].Select
End Sub