VBA: Problèmes avec les sous totaux

[Cacou78]

Bonjour, j'ai ce code suivant,et j'obtiens une erreur de type 1004 au niveau de ce que j'ai surligné en rouge.
J'ai sorti ce code de l'enregistreur de macros que j'ai modifié, a la base à ce niveau il y avait " array(4,5,6)".
Mais en fet j'ai besoin d'avoir un code générale, car mon tableau peut avoir 4 colonne comme 21. Sauriez vous comment faire?
En vous remerçiant, d'avance.
Rébecca

Sub tableau()
Dim DerLigne As Long
Dim DerColonne As Integer, I As Integer
Application.ScreenUpdating = False
With Sheets("Synt_charge")
DerLigne = .[A65000].End(xlUp).Row 'dernière ligne de la feuille Synt_charge
DerColonne = .[IV2].End(xlToLeft).Column 'dernière colonne de la ligne 2 de la feuille Synt_charge
End With
Sheets("Synt_charge").Activate
ActiveWindow.SmallScroll Down:=-14
Range(Cells(1, 1), Cells(DerLigne, DerColonne)).Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range( _
"B2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _ 'tri les colonnes a et b
:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Range(Cells(1, 4), Cells(1, DerColonne)), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True ' sous total en fonction de colonne a, des colonnes 4 jusqu'à la derniere
Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Range(Cells(1, 4), Cells(1, DerColonne)), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True ' sous total en fonction de colonne b, des colonnes 4 jusqu'à la derniere
ActiveSheet.Outline.ShowLevels RowLevels:=3
End Sub

 

[tototiti2008]

Re : VBA: Problèmes avec les sous totaux

Bonjour Cacou,

Et donc, si j'ai bien compris, tu souhaites avoir des totaux sur toutes les colonnes de la 4ième à la dernière, c'est bien ça ?

 

[Cacou78]

Re : VBA: Problèmes avec les sous totaux

oui c'est exactement ça.

 

[tototiti2008]

Re : VBA: Problèmes avec les sous totaux

Re,

à tester :

Sub tableau()
Dim DerLigne As Long
Dim DerColonne As Integer, I As Integer, [COLOR=red]Tablo() as Long[/COLOR]
Application.ScreenUpdating = False
With Sheets("Synt_charge")
DerLigne = .[A65000].End(xlUp).Row 'dernière ligne de la feuille Synt_charge
DerColonne = .[IV2].End(xlToLeft).Column 'dernière colonne de la ligne 2 de la feuille Synt_charge
[COLOR=red]Redim Tablo(DerColonne - 4)[/COLOR]
[COLOR=red]For I = LBound(Tablo) to Ubound(Tablo)[/COLOR]
[COLOR=red]Tablo(I) = I + 4[/COLOR]
[COLOR=red]Next I[/COLOR]
End With
Sheets("Synt_charge").Activate
ActiveWindow.SmallScroll Down:=-14
Range(Cells(1, 1), Cells(DerLigne, DerColonne)).Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range( _
"B2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _ 'tri les colonnes a et b
:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
Selection.Subtotal GroupBy:=1, Function:=xlSum, [COLOR=red]TotalList:=Tablo, _[/COLOR]
Replace:=False, PageBreaks:=False, SummaryBelowData:=True ' sous total en fonction de colonne a, des colonnes 4 jusqu'à la derniere
Selection.Subtotal GroupBy:=2, Function:=xlSum, [COLOR=red]TotalList:=Tablo[/COLOR], _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True ' sous total en fonction de colonne b, des colonnes 4 jusqu'à la derniere
ActiveSheet.Outline.ShowLevels RowLevels:=3
End Sub

 

[Cacou78]

Re : VBA: Problèmes avec les sous totaux

J'ai toujours le même probleme, il me met que la methode subtotal a échoué

 

[tototiti2008]

Re : VBA: Problèmes avec les sous totaux

Re,

Bizarre... sans un exemple des données, je ne vois pas trop

 

[Cacou78]

Re : VBA: Problèmes avec les sous totaux

Je viens de faire un fichier pour illustrer.
j'ai mis ton code dans le module 2

 

[Cacou78]

Re : VBA: Problèmes avec les sous totaux

En fait d'abord la macro trie par nom puis par type de projet et aprés elle fait les sous totaux.

 

[tototiti2008]

Re : VBA: Problèmes avec les sous totaux

Re,

essaye de remplacer

Selection.Subtotal GroupBy:=1, Function:=xlSum, [COLOR=red]TotalList:=Tablo, _[/COLOR]
Replace:=False, PageBreaks:=False, SummaryBelowData:=True ' sous total en fonction de colonne a, des colonnes 4 jusqu'à la derniere
Selection.Subtotal GroupBy:=2, Function:=xlSum, [COLOR=red]TotalList:=Tablo[/COLOR], _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True ' sous total en fonction de colonne b, des colonnes 4 jusqu'à la derniere

par

[COLOR=royalblue]Range("A1")[/COLOR].Subtotal GroupBy:=1, Function:=xlSum, [COLOR=red]TotalList:=Tablo, _[/COLOR]
Replace:=False, PageBreaks:=False, SummaryBelowData:=True ' sous total en fonction de colonne a, des colonnes 4 jusqu'à la derniere
[COLOR=royalblue]Range("A1")[/COLOR].Subtotal GroupBy:=2, Function:=xlSum, [COLOR=red]TotalList:=Tablo[/COLOR], _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True ' sous total en fonction de colonne b, des colonnes 4 jusqu'à la derniere

 

[Cacou78]

Re : VBA: Problèmes avec les sous totaux

oh merci. C'est parfait, ca marche!
Je te remercie