Sub Test()
'Déclaration ==================================
Dim F_D As Worksheet, F_A As Worksheet
Dim X As Long, total As Double
'MEI ==========================================
Set F_D = Sheets("Histo.")
Set F_A = Sheets("Pareto")
'Effacement des anciennes données =============
With F_A
If .Cells(Rows.Count, "B").End(xlUp).Row >= 9 Then _
.Range(.[B9], .Cells(Rows.Count, "B").End(xlUp)).EntireRow.Delete
'si dernière ligne non vide de B >= 9 supprimer de ligne 9 à dernière non vide en B
End With
'recherche des valeurs ========================
'Copie des titres -----------------------------
With F_D
If .FilterMode Then .ShowAllData
'si la feuille est filtrée, afficher toutes les données
X = [D8].End(xlDown).Row
'calcul de la dernière ligne de donnée
.Range(.[D8], .Cells(X, "D")).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
'Filtrer la plage D8 à dernière de D sur place, sans doublon
.Range(.[D8], .Cells(X, "D")).Copy F_A.[B9]
If .FilterMode Then .ShowAllData
End With
'Copie 1ère formule ---------------------------
F_A.Activate
If [G6] = "" And [G7] = "" Then
[C9].FormulaLocal = _
"=SOMMEPROD((Histo.!$D$8:$D$" & X & "=Pareto!B9)*(Histo.!$G$8:$G$" & X & "))"
End If
If [G6] > 0 And [G7] = "" Then
[C9].FormulaLocal = _
"=SOMMEPROD((Histo.!$D$8:$D$" & X & "=Pareto!B9)*(Pareto!$G$6<=Histo.!$B$8:$B$" & X & _
")*(Histo.!$G$8:$G$" & X & "))"
End If
If [G7] > 0 And [G6] = "" Then
[C9].FormulaLocal = _
"=SOMMEPROD((Histo.!$D$8:$D$" & X & "=Pareto!B9)*(Histo.!$B$8:$B$" & X & _
"<=Pareto!$G$7)*(Histo.!$G$8:$G$" & X & "))"
End If
If [G6] > 0 And [G7] > 0 Then
[C9].FormulaLocal = _
"=SOMMEPROD((Histo.!$D$8:$D$" & X & "=Pareto!B9)*(Pareto!$G$6<=Histo.!$B$8:$B$" & X & _
")*(Histo.!$B$8:$B$" & X & "<=Pareto!$G$7)*(Histo.!$G$8:$G$" & X & "))"
End If
X = Cells(Rows.Count, "B").End(xlUp).Row
[C9].AutoFill Destination:=Range([C9], Cells(X, "C")), Type:=xlFillDefault
'Figeage valeurs + tri ===========================
With Range([B9], Cells(X, "C"))
.Copy
.PasteSpecial Paste:=xlPasteValues
.Sort Key1:=Range("C9"), Order1:=xlDescending, Key2:=Range("B9") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1
End With
'Copie autre formules ============================
[D10].FormulaLocal = "=C10/somme($C$9:$C$" & X & ")"
[D10].NumberFormat = "0.00%"
[D10].Copy [D9]
[E9].FormulaLocal = "=D9"
[E10].FormulaLocal = "=D10+E9"
[D10:E10].Copy Range("D10:E" & X)
'Mise en forme ===================================
'Formatage données -------------------------------
With Range("B9:E" & X)
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
'formatage titre --------------------------------
With [B8:E8]
With .Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
End With
With .Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
End With
End With
Range("B9").Activate
End Sub