Sous -totaux par département

bonjour,
qu'as-tu essayé?
as-tu essayé un tableau croisé dynamique?

Merci pour ta réponse
Je sais ke faire sous forme de tableau croisés.
Mais là je veux le faire en VBA étant donné que j'ai commencé l'automatisation en VBA.

Bonjour,

J'ai essayer ce code pour un exemple plus court mais dans le même principe (Faire un sous total par catégorie).

le code ne fonctionne pas du tout

j'ai commencé l'automatisation je veux dire par la que j'ai écrit un programme qui me permet de faire apparaitre toutes les données souhaitées.

Confère l'image du premier message.

Sub ResultatAnnuel()

Dim NomRM As String

Dim RM As Worksheet
Dim loRM As ListObject
Dim DerniereLigneRM As Integer
Dim CategorieCourante As String
Dim NumeroCompteOperation As String
Dim CodeEtablissement As String
Dim LigneResultat As Integer
Dim LignePPI As Integer
LignePPI = LignePPI + 1

Dim Resultat As Worksheet
Set Resultat = Sheets("Résultat")

Dim TrainPPIS1 As Worksheet

Set TrainPPIS1 = Sheets("TrainPPIS1")

Dim LigneRM As Integer
Dim SumResultat As Double
Dim SumMaquette As Double
Dim DepartementMOA As String
Dim Maquette As Worksheet
Set Maquette = Sheets("Maquette")

Dim LigneMaquette As Integer
LigneMaquette = LigneMaquette + 1
Dim DerniereLigneMaquette As Integer
DerniereLigneMaquette = Maquette.Cells(Rows.Count, 1).End(xlUp).Row + 1

Dim NumColo As Integer
NumColo = 9
Dim NumColoMaquete As Integer
NumColoMaquete = 25

Resultat.Cells(1, 2).Value = "Code Compte Operation"
Resultat.Cells(1, 8).Value = "Code Type Financement"
Resultat.Cells(1, 6).Value = "Libellé long SSDM"
Resultat.Cells(1, 5).Value = "Libellé long SDM"
Resultat.Cells(1, 7).Value = "Libellé Catégorie"
Resultat.Cells(1, 4).Value = "Code Unité MOA Projet"
'Resultat.Cells(1, 3).Value = "Code Département MOA Projet(selon Résultat)"
Resultat.Cells(1, 3).Value = "Code Département MOA Projet(selon PPI)"
Resultat.Cells(1, 1).Value = "Code Etablissement Comptable"
Resultat.Cells(1, 7).Value = "Libellé Catégorie"

For Each WS In ThisWorkbook.Worksheets

If WS.Name Like "*RM20*" Then

NomRM = WS.Name
Set RM = Sheets(NomRM)

CreerTableau RM, NomRM & "Tab"

Set loRM = RM.ListObjects(NomRM & "Tab")
With loRM.Sort
With .SortFields
.Clear
.Add Key:=loRM.ListColumns("Code Compte Operation").DataBodyRange, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

End With
.Header = xlYes
.MatchCase = False
.Apply
End With

DerniereLigneRM = RM.Cells(Rows.Count, 1).End(xlUp).Row
CategorieCourante = RM.Cells(2, 23).Value
NumeroCompteOperation = RM.Cells(2, 1).Value

LigneResultat = 8

CodeEtablissement = "GI"

'RESULTATS ANNUELS

For LigneRM = 2 To DerniereLigneRM + 1

DansTableau = DansTableauResultat(NumeroCompteOperation)

If RM.Cells(LigneRM, 5) = CodeEtablissement Then

If DansTableau = -1 Then
LigneRM1 = LigneRM
DerniereLigneResultat = Resultat.Cells(Rows.Count, 1).End(xlUp).Row + 1

While RM.Cells(LigneRM1, 1).Value = NumeroCompteOperation
SumResultat = SumResultat + RM.Cells(LigneRM, 26) / 1000000
LigneRM1 = LigneRM1 + 1

Wend
Resultat.Cells(DerniereLigneResultat, 2).Value = RM.Cells(LigneRM - 1, 1).Value
Resultat.Cells(DerniereLigneResultat, 1).Value = RM.Cells(LigneRM - 1, 5).Value
Resultat.Cells(DerniereLigneResultat, 8).Value = RM.Cells(LigneRM - 1, 13).Value
Resultat.Cells(DerniereLigneResultat, 6).Value = RM.Cells(LigneRM - 1, 21).Value
Resultat.Cells(DerniereLigneResultat, 5).Value = RM.Cells(LigneRM - 1, 19).Value

Resultat.Cells(DerniereLigneResultat, 7).Value = RM.Cells(LigneRM - 1, 23).Value
Resultat.Cells(DerniereLigneResultat, 4).Value = RM.Cells(LigneRM - 1, 15).Value
'Resultat.Cells(DerniereLigneResultat, 3).Value = RM.Cells(LigneRM - 1, 16).Value
Resultat.Cells(DerniereLigneResultat, 3).Value = DanstableauTraindPPIS1(RM.Cells(LigneRM - 1, 23))

'Resultat.Cells(DerniereLigneResultat, 27).Value = DansTableauMaquette1(RM.Cells(LigneRM - 1, 23))
'Resultat.Cells(DerniereLigneResultat, 28).Value = DansTableauMaquette2(RM.Cells(LigneRM - 1, 23))
'Resultat.Cells(DerniereLigneResultat, 29).Value = DansTableauMaquette3(RM.Cells(LigneRM - 1, 23))
'Resultat.Cells(DerniereLigneResultat, 30).Value = DansTableauMaquette4(RM.Cells(LigneRM - 1, 23))

'Resultat.Cells(DerniereLigneResultat, 31).Value = DansTableauMaquette20212024(RM.Cells(LigneRM - 1, 23))

'Resultat.Cells(DerniereLigneResultat, 23).Value = RM.Cells(LigneRM - 1, 5).Value

Resultat.Cells(DerniereLigneResultat, NumColo).Value = SumResultat

Resultat.Cells(1, NumColo).Value = Right(RM.Name, 4)
SumResultat = RM.Cells(LigneRM, 26) / 1000000
CategorieCourante = RM.Cells(LigneRM, 23).Value
NumeroCompteOperation = RM.Cells(LigneRM, 1).Value

Else
While RM.Cells(LigneRM1, 1).Value = NumeroCompteOperation
SumResultat = SumResultat + RM.Cells(LigneRM1, 26) / 1000000
LigneRM1 = LigneRM1 + 1

Wend

Resultat.Cells(DansTableau, NumColo).Value = SumResultat
SumResultat = RM.Cells(LigneRM, 26) / 1000000
CategorieCourante = RM.Cells(LigneRM, 23).Value
NumeroCompteOperation = RM.Cells(LigneRM, 1).Value

End If

Else

End If

Next
NumColo = NumColo + 1
End If

Next

End Sub

Bonjour merci pour ton retour.

Je n'ai en effet pas fait de tri par département.

Je vais le faire avec la fonctionnalité enregistrer une macro et je créerai un bouton pour ça.