XL 2016 Sous-totaux ou WorksheetFunction.Sum

[Aldonanou]

Bonjour,

Je récupère deux fichiers issus de Business Object. La version Excel du document additionne les divers montants d'une même référence pour en faire la synthèse. Le document Excel étant trop compliqué à traiter (champs fusionnés, titre décalé ...) , je me sers de la version .csv pour effectuer le traitement.
Après avoir effectué tous les calculs pour les remonter dans les bonnes colonnes, je dois effectuer des sous-totaux. Le sous-total me génère une ligne supplémentaire or j'ai besoin que d'avoir les informations de la référence pour faire mon fichier final.
Actuellement, avec le développement effectué j'ai une ligne avec les données de la référence et la ligne en dessous avec les sous-totaux.
Je sais qu'il est possible de créer via une fonction la somme (type sous-totaux) sur les colonnes AE à AM.

Je joins le code et le fichier (deux onglets Détection avec le résultat actuellement, et Détection O. Les données de la colonne C en rouge sont celles qui m'intéressent.

Je n'arrive pas à trouver de solutions. Il y a certainement une autre possibilité.

Pourriez-vous m'aider. Merci

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

 

[fanfan38]

Bonjour
Ci joint ma solution

A+ François

 

[Aldonanou]

Bonjour fanfan38, meilleurs vœux pour cette année. Je récupère le fichier chez moi pour étude et reviens vers vous. Merci