1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
| Sub Somme_AB()
'Tot => Enlever Pour afficher le total dans chaque feuille
Application.DisplayAlerts = False
Dim FA As Worksheet
Dim FB As Worksheet
Dim Mycell As Range
Dim CompteurAB As Long
Dim CompteurA As Long
Dim CompteurB As Long
' ------------------------------------------------------ '
' Cumul des compteurs de la colonne A dans la feuille A
' ------------------------------------------------------ '
Set FA = Worksheets("A")
'Tot If FA.Range("A65536").End(xlUp) = "Total A : " Then FA.Range("A65536").End(xlUp).ClearContents:
Set Mycell = FA.Range("A65536").End(xlUp)
For i = 2 To Mycell.Row 'On suppose qu'il y a une ligne des titres
CompteurA = CompteurA + FA.Cells(i, Mycell.Column + 1)
Next i
'Tot Mycell.Offset(1, 0) = "Total A : "
'Tot Mycell.Offset(1, 1) = CompteurA
'MsgBox CompteurA
' ------------------------------------------------------ '
' Cumul des compteurs de la colonne B dans la feuille B
' ------------------------------------------------------ '
Set FB = Worksheets("B")
'Tot If FB.Range("A65536").End(xlUp) = "Total B : " Then FB.Range("A65536").End(xlUp).ClearContents:
Set Mycell = FB.Range("A65536").End(xlUp)
For i = 2 To Mycell.Row 'On suppose qu'il y a une ligne des titres
CompteurB = CompteurB + FB.Cells(i, Mycell.Column + 1)
Next i
'Tot Mycell.Offset(1, 0) = "Total B : "
'Tot Mycell.Offset(1, 1) = CompteurB
'MsgBox CompteurB
' ----------------------------------------------------------- '
' Creation d'un nouvel onglet avec les sommes correspondantes
' ----------------------------------------------------------- '
Const NouvelOnglet = "Résultat A et B"
Dim F1 As Worksheet
' ------------------------------- '
' Existence de l'onglet
' ------------------------------- '
For Each F1 In Sheets
If F1.Name = NouvelOnglet Then 'Suppression de l'onglet s'il existe deja
F1.Delete
Exit For
'' Autre solution => sortie s'il existe deja
''MsgBox "La feuille " & F1.Name & " existe déja", vbInformation, "Classeur " & ThisWorkbook.Name
''goto gesterror
End If
Next F1
' ------------------------------- '
' Ajout de l'onglet
' ------------------------------- '
Set F1 = Sheets.Add(After:=Sheets(Sheets.Count))
F1.Name = NouvelOnglet
' ------------------------------- '
' Affichage du résultat
' ------------------------------- '
CompteurAB = CompteurA + CompteurB
Range("A1") = "Total A"
Range("B1") = "Total B"
Range("C1") = "Total A + B"
Range("A2") = CompteurA
Range("B2") = CompteurB
Range("C2") = CompteurAB
gesterror:
Application.DisplayAlerts = True
End Sub |
Partager