MACRO: Rajouter des sous totaux sur les feuilles cibles (RESOLU)

[luno123]

Bonjour,

J'ai une macro ci dessous qui fonctionne bien pour l'instant.

Sub RépartirImmo()
Dim Collec As New Collection
Dim Cell As Range
Dim ITM As Byte
Application.ScreenUpdating = False
With Sheets("IMMO")
For Each Cell In .Range("B4:B" & .Range("B65536").End(xlUp).Row)
On Error Resume Next
Collec.Add (Cell), CStr(Cell)
On Error GoTo 0
Next
For ITM = 1 To Collec.Count

On Error Resume Next
Application.DisplayAlerts = False
Sheets(Collec(ITM)).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Sheets.Add
ActiveSheet.Name = Collec(ITM)
Range("A1") = "Désignation du bien"
Range("B1") = "Numéro Compte"
Range("C1") = "Montant Amortissements"
Range("A1:C1").Interior.ColorIndex = 13
Range("E1") = "Montant total des autres amortissements"
Range("E2") = "Montant total des amortissements des véhicules"
Columns("A:C").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Next
For Each Cell In .Range("B4:B" & .Range("B65536").End(xlUp).Row)
Range(Cell.Offset(0, 2), Cell.Offset(0, 3)).Copy Destination:=Sheets(Cell.Value).Range("A" & Sheets(Cell.Value).Range("A65536").End(xlUp).Row + 1)
Cell.Offset(0, 11).Copy Destination:=Sheets(Cell.Value).Range("C" & Sheets(Cell.Value).Range("A65536").End(xlUp).Row)
Sheets(Cell.Value).Range("F1") = Sheets(Cell.Value).Range("F1") + Cell.Offset(0, 11)
If Sheets(Cell.Value).Name = "ImmoStructure" Then
Sheets("Frais Structure").Range("C17") = Sheets(Cell.Value).Range("F1") / 1000
ElseIf Sheets(Cell.Value).Name = "ImmoCommercial" Then
Sheets("Frais Commerciaux").Range("C17") = Sheets(Cell.Value).Range("F1") / 1000
ElseIf Sheets(Cell.Value).Name = "ImmoFabrication" Then
Sheets("Frais Fabrication").Range("D16") = Sheets(Cell.Value).Range("F1") / 1000
End If
Next
End With
Application.Goto reference:=Sheets("IMMO").Range("A1"), scroll:=True
End Sub


Je souhaite y apporter quelques critères en plus.

A partir de la feuille "IMMO" (feuille en rouge), je crée (en appuyant sur répartir) 3 feuilles cibles (ImmoStructure, ImmoFabication,ImmoCommercial) où sont réparties les immo en fonction de leur affectation(Cf. colonne B de la feuille IMMO).
Sur chaque nouvelle feuille ainsi créée j'ai pour l'instant le total des amortissements qui est envoyé automatiquement (via la macro) sur 3 autres feuilles en couleur verte sur mon exemple (Frais Structure, Frais Commercial, Frais Fabrication).

Mon souhait est de rajouter un autre critère à ma macro dans les 3 feuilles cibles. Ce critère me permettrait de distinguer, le total des amortissements des véhicules(F2) pour chaque service & le total du reste des autres amortissements(F1).

POUR ËTRE PLUS CLAIR: la somme de la colonne C des feuilles cibles(ImmoStructure, ImmoFabication,ImmoCommercial) devrait être éclatée en 2:
- Une première somme qui ne contient que les montants des immo des véhicules (partie grisée) ayant comme numéro de compte 21820000
- une deuxième somme regroupant tout le reste.

En guise d'illustration, on devrait avoir par exemple pour la feuille ImmoCommercial:
- en cellule F1: 2 614.42 euros
- en F2: 18 598.13 correspondant à la partie grisée.

PS/ Au niveau des 3 feuilles (FraisStructure, FraisFabrication, FraisCommercial), les montants précédement calculés, sont exprimés en Keuros donc divisés par 1000 pour une question d'espace.

Merci d'avance pour votre aide.

 

[Efgé]

Re : MACRO: Rajouter des sous totaux sur les feuilles cibles

Bonjour luno123, le fil, le forum,
Suite à M.P....

Si personne ne répond à ton problème c'est peut être parce que la question semble un peu indigeste

Pour calculer tes "Sous totaux" je n'ai pas trop le temps, ni la foi pour être honnète, de me plonger dans le code.
Je pense que par formule tu peux le faire (quite à écrire la formule avec ton code )

Pour le calcul des amortissements (feuille ImmoCommercial de ton exemple) :

=SOMMEPROD((C2:C12)*(B2:B12=21820000))

Pour le calcul des "Autres" :

=SOMMEPROD((C2:C12)*(B2:B12<>21820000))

En espérant que cela pourra te faire avancer.
Cordialement

 

[bond]

Re : MACRO: Rajouter des sous totaux sur les feuilles cibles

Si personne ne répond à ton problème c'est peut être parce que la question semble un peu indigeste

je n'ai pas trop le temps, ni la foi pour être honnète, de me plonger dans le code

NB : Utilise les balises de code.

 

[Efgé]

Re : MACRO: Rajouter des sous totaux sur les feuilles cibles

Re luno, Bonjour Mister Bond , Bonjour Jean-Marcel ,


Ne sommes nous pas en train de voir la création d'une nouvelle forme de fil

• je post, un peu n'importe comment
• Je n'ai pas de réponses spontannées
• J'envoie des messges privés à droite, à gauche (sans répondre aux questions posées en retour)
• Je vois ce qui se passe
• Et, surtout, je ne donne pas signe de vie sur mon fil

C'est à des petits riens comme celui ci que l'on peux se poser des questions....

Cordialement

EDIT Sans même parler de la note de 5 étoiles mise au fil, sans même avoir eu l'ombre du début d'une réponse

 

[MJ13]

Re : MACRO: Rajouter des sous totaux sur les feuilles cibles

Bonjour à tous

Ne sommes nous pas en train de voir la création d'une nouvelle forme de fil

Et bien, Efgé, tu ne dois pas souvent venir sur le forum .

 

[luno123]

Re : MACRO: Rajouter des sous totaux sur les feuilles cibles

@ Efgé

Excuse moi si je t'ai dérangé (e)! Tu t'emballes vite j'ai l'impression. On ne vient pas sur ce forum pour se prendre la tête mais pour s'entraider. Si quelqu’un te demande un service que tu n’es pas prêt (e) à rendre, tu n’es pas obligé (e) d’être désagréable mon (ma) cher (e).
D’autre part excuse de travailler donc de ne pas être tout le temps sur le forum.

« Forument » vôtre… cet espace est pour tout le monde…

Merci à tout ce qui ont répondu ou ceux qui auraient voulu répondre.

Je teste tout ça & je vous fais signe avant que Efgé ne s’emballe de nouveau.

 

[luno123]

Re : MACRO: Rajouter des sous totaux sur les feuilles cibles

@ Efgé,

J'avais pensé à une formule. Sauf avec ma macro, une formule n'est pas appliquable car à chaque fois que j'effectue une nouvelle répartiton via le bouton " répartir ", mes feuilles cibles sont détruites & recrées.
La macro de Jean Marcel semble fonctionner. Je dois y apporter quelques modifications car il s'est trompé sur " une petite chose" mais sinon il a bien répondu à ma demande.

Je vous tiens au courant la familia.

Luno

 

[luno123]

Re : MACRO: Rajouter des sous totaux sur les feuilles cibles

@ Jean Marcel & co

Ton code fonctionne à merveille. J'y ai apporté quelques modifications car certains sous totaux n'allaient pas sur les bonnes cellules. Sinon chapeau bas pour les modifications que tu as pu apportées à mon code afin d'avoir le résultat escompté.

Merci encore à la familia XLD

Luno