ajouter le total

bonjour,

j'ai une macro, qui avez été faite par vous ;)
elle me permet d'éclater 1 tableau contenu dans un onglet en autant
d'onglets que j'ai d'imputations différentes dans mon fichier.
ça fonctionne au poil !

je voudrais juste savoir, si il est possible d'ajouter la somme d'un colonne
automatiquement sur tous les onglets créés ?


merci d'avance

je vous redonne la macros que j'utilise actuellement :

'********************
Option Explicit
Const SERVICE As String = "Imputation"

Sub EclaterOnglets_PMO()

Range("A1").Select
Dim var
Dim Origine As Worksheet
Dim W As Workbook
Dim S As Worksheet
Dim Source As Worksheet
Dim Cle&
Dim R As Range
Dim i&
Dim j&
Dim deb&
Dim fin&
Dim TR()
Dim Titres
Dim nbLig&
Set R = ActiveSheet.UsedRange
If R.Row > 1 Or R.Column > 1 Then
MsgBox "La plage doit débuter en ligne 1 colonne A."
Exit Sub
End If
nbLig& = R.Rows.Count
var = R
For j& = 1 To UBound(var, 2)
If var(1, j&) = SERVICE Then
Cle& = j&
Exit For
End If
Next j&
If Cle& = 0 Then
MsgBox "Titre de colonne " & SERVICE & " introuvable."
Exit Sub
End If
Set Origine = ActiveSheet
Set W = Workbooks.Add(xlWorksheet)
Origine.Copy after:=W.Sheets(1)
Application.DisplayAlerts = False
W.Sheets(1).Delete
Set S = W.ActiveSheet
Application.DisplayAlerts = True
Set R = S.UsedRange
R.Sort Key1:=Range(Cells(2, Cle&), Cells(2, Cle&)), Order1:=xlAscending,
Header:=xlYes
var = R
Titres = R.Range(Cells(1, 1), Cells(1, UBound(var, 2)))
j& = 0
fin& = UBound(var, 1)
For i& = UBound(var, 1) To 2 Step -1
If var(i&, Cle&) <> var(i& - 1, Cle&) Then
deb& = i&
j& = j& + 1
ReDim Preserve TR(1 To j&)
TR(j&) = R.Range(Cells(deb&, 1), Cells(fin&, UBound(var, 2)))
fin& = i& - 1
End If
Next i&
On Error GoTo Erreur
Set Source = W.ActiveSheet
Application.ScreenUpdating = False
For i& = 1 To UBound(TR)
Source.Copy after:=W.Sheets(1)
Set S = W.ActiveSheet
S.Cells.ClearContents
S.Range(Cells(1, 1), Cells(1, UBound(var, 2))) = Titres
S.Range(Cells(2, 1), Cells(UBound(TR(i&)) + 1, UBound(var, 2))) = TR(i&)
S.Rows("" & UBound(TR(i&)) + 2 & ":" & nbLig& & "").Delete
S.Name = TR(i&)(1, Cle&)
S.[a1].Select
Next i&
Erreur:
W.Sheets(1).Select
[a1].Select
Application.ScreenUpdating = True
End Sub
'********************