XL 2016 Sous-totaux ou WorksheetFunction.Sum

Sub SousTotaux()

Dim i As Long
Dim Iprec As Long
Dim Gestionnaire As String
Dim Référence As String
Dim strNom As String
Dim Code As String
Dim Indicateur As String
Dim TypeD As String
Dim Notation As String
Dim Info As String
Dim Avis As String
Dim Service As String
Dim I1A As Double
Dim I2B As String
Dim I3C As Double
Dim I4D As Double
Dim I5E As Double
Dim I6F As String
Dim DonnéesCT As Long
Dim DonnéesMTLT As Double
Dim AvisV As Double
Dim Engagements As Double
Dim Utilisations As Double
Dim Auto As Double
Dim Total As Double
Dim ValeurInfo As Double

' Insère une nouvelle colonne pour le travail
Columns("A:A").Copy
Columns("A:A").Insert Shift:=xlToRight
Application.CutCopyMode = False


' Début
i = 1
'Boucle sur tant que la colonne C n'est pas vide
Do While Range("C" & i).Value <> ""

'Si nom de la ligne <> de la référence précédente
If Référence <> Range("C" & i).Value Then
If Référence <> "" Then
'insère une ligne pour y copier les valeurs de la ligne précédente
Rows(i).Insert

'insère la somme
Range("A" & i).FormulaLocal = "=somme(A" & Iprec & ":A" & i - 1 & ")"

'Ajoute les valeurs
Range("B" & i).Value = Gestionnaire
Range("C" & i).Value = Référence
Range("D" & i).Value = strNom
Range("E" & i).Value = Code
Range("F" & i).Value = Indicateur
Range("G" & i).Value = TypeD
Range("H" & i).Value = Notation
Range("I" & i).Value = Info
Range("J" & i).Value = Avis
Range("K" & i).Value = Service
'Range("L" & i).Value = I1A 'Montant
Range("M" & i).Value = I2B
'Range("N" & i).Value = I3C 'Montant
'Range("O" & i).Value = I4D
'Range("P" & i).Value = I5E
'Range("Q" & i).Value = I6F

'Range("AE" & i).Value = DonnéesCT
'Range("AF" & i).Value = DonnéesMTLT
'Range("AG" & i).Value = AvisV
'Range("AH" & i).Value = Engagements
'Range("AI" & i).Value = Utilisations
'Range("AJ" & i).Value = Auto
'Range("AK" & i).Value = Total
'Range("AM" & i).Value = ValeurInfo

With Range("C" & i)
.Font.Bold = True
.Font.Color = vbRed
End With

'Regroupe les lignes
Rows(Iprec & ":" & i - 1).Group

'mémorise la ligne de début de la prochaine section
Iprec = i + 1
Else
Iprec = i
End If

Gestionnaire = Range("B" & i + 1).Value
Référence = Range("C" & i + 1).Value
strNom = Range("D" & i + 1).Value
Code = Range("E" & i + 1).Value
Indicateur = Range("F" & i + 1).Value
TypeD = Range("G" & i + 1).Value
Notation = Range("H" & i + 1).Value
Info = Range("I" & i + 1).Value
Avis = Range("J" & i + 1).Value
Service = Range("K" & i + 1).Value
'I1A = WorksheetFunction.Sum(Range("L" & i + 1))
IB2 = Range("M" & i + 1).Value
'IC3 = WorksheetFunction.Sum(Range("N" & i + 1))
'ID4 = WorksheetFunction.Sum(Range("O" & i + 1))
'IE5 = WorksheetFunction.Sum(Range("P" & i + 1))
IF6 = Range("Q" & i + 1).Value
'DonnéesCT = WorksheetFunction.Sum(Range("AE" & i + 1))
'DonnéesMTLT = WorksheetFunction.Sum(Range("AF" & i + 1))
'AvisV = WorksheetFunction.Sum(Range("AG" & i + 1))
'Engagements = WorksheetFunction.Sum(Range("AH" & i + 1))
'Utilisations = WorksheetFunction.Sum(Range("AI" & i + 1))
'Auto = WorksheetFunction.Sum(Range("AJ" & i + 1))
'Total = WorksheetFunction.Sum(Range("AK" & i + 1))
'ValeurInfo = WorksheetFunction.Sum(Range("AM" & i + 1))


End If
i = i + 1
Loop
'insère la dernière formule
Range("A" & i).FormulaLocal = "=somme(A" & Iprec & ":A" & i - 1 & ")"
Range("B" & i).Value = Gestionnaire
Range("C" & i).Value = Référence
Range("D" & i).Value = strNom
Range("E" & i).Value = Code
Range("F" & i).Value = Indicateur
Range("G" & i).Value = TypeD
Range("H" & i).Value = Notation
Range("I" & i).Value = Info
Range("J" & i).Value = Avis
Range("K" & i).Value = Service
'Range("L" & i).Value = I1A 'Montant
Range("M" & i).Value = I2B
'Range("N" & i).Value = I3C 'Montant
Range("O" & i).Value = I4D
Range("P" & i).Value = I5E
Range("Q" & i).Value = I6F
'Range("AE" & i).Value = DonnéesCT
'Range("AF" & i).Value = DonnéesMTLT
'Range("AG" & i).Value = AvisV
'Range("AH" & i).Value = Engagements
'Range("AI" & i).Value = Utilisations
'Range("AJ" & i).Value = Auto
'Range("AK" & i).Value = Total
'Range("AM" & i).Value = ValeurInfo

With Range("C" & i)
.Font.Bold = True
.Font.Color = vbRed
End With

Rows(Iprec & ":" & i - 1).Group


With Worksheets("Détection").Range("A:AM")
.RemoveSubtotal
.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(12, 14, 15 _
, 16, 31, 32, 33, 34, 35, 36, 37, 39), Replace:=True ', SummaryBelowData:=True
End With

End Sub

Cliquez pour agrandir...