Déplacer une ligne "Total" en dernière ligne d'un tableau

lapluchouet

XLDnaute Nouveau
Bonjour, bonjour,

J'ai une question pour laquelle j'espère qu'aucune discussion n'a déjà été ouverte, sinon je m'en excuse ! (j'ai cherché sur le forum, mais n'ai rien trouvé qui s'en rapproche).
J'ai des tableaux comme ceux présentés dans mon fichier ("Onglet ce que j'ai") :

Regarde la pièce jointe 360987

Pour lesquels la ligne Total se trouve en première position... sauf que je la voudrais en dernière position... !
Je suis donc à la recherche d'une macro qui me descendrait cette ligne Total en dernière position, tout en conservant une belle mise en forme (cf fichier Excel joint - Onglet "Ce que je veux") et comme je ne fais pas partie de la catégorie des gens doués en macro :D , je m'en remets à vos lumières :rolleyes:

Merci d'avance.

Aude
 

Pièces jointes

  • Excel_Macro_Total.xlsx
    14.6 KB · Affichages: 55

CISCO

XLDnaute Barbatruc
Re : Déplacer une ligne "Total" en dernière ligne d'un tableau

Bonjour

cf. en pièce jointe, avec le code suivant :
Code:
Sub macro2()
Dim i As Integer, j As Integer, k as Integer, Derligne As Integer
Application.ScreenUpdating = False
Derligne = 0
Dernligne = Range("B1048576").End(xlUp).Row
Range("A1:A" & Dernligne).UnMerge
Range("A1:A" & Dernligne).Copy
Range("A3").PasteSpecial xlValue
For i = ((Dernligne - 1) / 7) To 1 Step -1
j = 7 * i + 1
Rows(j & ":" & j).Select
Selection.Insert Shift:=xlUp
Range("A" & j + 1 & ":D" & j + 1).Copy
Range("A" & j).PasteSpecial xlValue
Range("B" & j - 6 & ":D" & j - 6).Copy
Range("B" & j + 1).PasteSpecial xlValue
Rows(j - 6 & ":" & j - 6).Select
Range("B" & j - 6).Activate
Selection.Delete Shift:=xlUp
Next
For k = 1 To ((Dernligne - 1) / 7)
Range("A" & ((k - 1) * 7 + 2) & ":A" & ((k - 1) * 7 + 8)).Merge
Next
Range("A1:A" & Dernligne).EntireRow.AutoFit
Application.ScreenUpdating = True
End Sub

@ plus
 

Pièces jointes

  • Excel_Macro_Total2.xlsm
    23.9 KB · Affichages: 51
  • Excel_Macro_Total2.xlsm
    23.9 KB · Affichages: 51
Dernière édition:

lapluchouet

XLDnaute Nouveau
Re : Déplacer une ligne "Total" en dernière ligne d'un tableau

Super ! Merci beaucoup !

Et crois-tu que ça soit possible de ne pas donner à la macro un nombre exact de lignes ?
Parce que j'ai plusieurs formats de tableaux qui présentent le total en première ligne et le nombre de lignes du tableau est donc aléatoire...

Merci encore :D

Aude
 

Paf

XLDnaute Barbatruc
Re : Déplacer une ligne "Total" en dernière ligne d'un tableau

Bonjour lapluchouet, CISCO,

une autre version
Code:
Sub Inverse()
 Dim WS As Worksheet, NbL As Byte, i As Integer

 Set WS = Worksheets("Ce que j'ai") ' à adapter
 NbL = WS.Range("A2").MergeArea.Rows.Count ' nombre de lignes par bloc ,
 Application.ScreenUpdating = False
 For i = 2 To WS.Range("A" & Rows.Count).End(xlUp).Row Step NbL
    'insertion ligne fin de bloc
    WS.Range("B" & i + NbL & ":D" & i + NbL).Insert Shift:=xlDown
    'copie première ligne sur ligne ajoutée
    WS.Range("B" & i + NbL & ":D" & i + NbL) = WS.Range("B" & i & ":D" & i).Value
    'suppression avec décalage vers le haut de la première ligne
    WS.Range("B" & i & ":D" & i).Delete Shift:=xlUp
    'réajustement des bordures
    With WS.Range("B" & i).Resize(NbL, 3)
     .Borders.Weight = xlThick
     .Borders(xlInsideHorizontal).Weight = xlThin
    End With
    WS.Range("C" & i).Resize(NbL, 2).Borders(xlInsideVertical).Weight = xlThin
 Next
 Application.ScreenUpdating = True
End Sub

Fonctionne si en colonne A les lignes sont fusionnées par item (comme dans l'exemple) et quelque soit le nombre de lignes total et le nombre de lignes par bloc (si le nombre de ligne est toujours le même)

A+
 

CISCO

XLDnaute Barbatruc
Re : Déplacer une ligne "Total" en dernière ligne d'un tableau

Bonsoir à tous, bonsoir Paf

Super ! Merci beaucoup !

Et crois-tu que ça soit possible de ne pas donner à la macro un nombre exact de lignes ?

Merci encore :D

Aude

Normalement, la macro précédente (post #2) fonctionne avec un nombre quelconque de lignes (grâce à Dernligne = Range("B1048576").End(xlUp).Row). Par contre, il faut que chaque paquet ait 7 lignes.

@ plus
 
Dernière édition:

CISCO

XLDnaute Barbatruc
Re : Déplacer une ligne "Total" en dernière ligne d'un tableau

Bonsoir

Pour le fun (la proposition de Paf fonctionnant déjà bien pour faire cela), en pièce jointe, une macro fonctionnant avec un nombre de lignes dans chaque paquet pas forcément égal à 7.

@ plus
 

Pièces jointes

  • Excel_Macro_Total2.xlsm
    24.6 KB · Affichages: 55
  • Excel_Macro_Total2.xlsm
    24.6 KB · Affichages: 42

lapluchouet

XLDnaute Nouveau
Re : Déplacer une ligne "Total" en dernière ligne d'un tableau

Coucou !!

MERCI !! Vous êtes géniaux ! Vous voudriez bien me prêter un bout de votre cerveau ? :D
C'est super ! Et merci aussi pour les précisions sur chaque ligne, c'est génial, ça me permet d'essayer de comprendre !

Par contre, dans ta dernière proposition de macro (pour le fun), l'avant dernière ligne se modifie de la même façon que celle qui la précède (fond de couleur + gras), dont la mise en forme ne concerne que les Sous-totaux (ST -).

Et je pousse la réflexion plus loin avec une nouvelle question... (oui, vous l'avez compris... je suis bien une femme ! :rolleyes: HAHAHA)
Est-ce qu'on pourrait imaginer de déclencher la macro en sélectionnant le tableau qui m'intéresse (nombre de lignes ET nombre de colonnes aléatoires) ? car sur une page je peux avoir plein de tableaux différents (avec un nombre de colonnes différents) et je voudrais que la macro s'exécute uniquement sur ceux que je détermine.
C'est à dire que certains tableaux présentent le total en première ligne (ceux-là m'embêtent, alors que les autres ont le total en bas et me vont très bien.

Je joins un autre document pour illustrer cette nouvelle question...

Merci encore !!

Aude
 

Pièces jointes

  • Excel_Macro_Total_bis.xlsx
    16.5 KB · Affichages: 39

CISCO

XLDnaute Barbatruc
Re : Déplacer une ligne "Total" en dernière ligne d'un tableau

Bonjour

Une autre possibilité en pièce jointe, correspondant à ta première demande, avec un code plus simple.
Code:
Sub macro3()
Dim Paquetbis()
Dim i As Integer, Derligne As Integer, Paquetligne As Integer
'Affichage à l'écran supprimé
Application.ScreenUpdating = False
Dernligne = Range("B1048576").End(xlUp).Row
Paquetligne = Range("A2").MergeArea.Rows.Count
'Modification dans chaque partie de Paquetligne lignes,
    For i = 2 To Dernligne Step Paquetligne
    'Stockage
    Paquetbis = Range("B" & (i + 1) & ":D" & (i + Paquetligne - 1)).Value
    'Copie de la patie Total de B:D
    Range("B" & i & ":D" & i).Copy
    'Collage des valeurs de cette partie sur la dernière plage B:D du paquet en cour
    Range("B" & i + Paquetligne - 1).PasteSpecial xlValue
    'Collage de Paquetbis sur la plage Bi:Davantdernièreligne
    Range("B" & i & ":D" & (i + Paquetligne - 2)) = Paquetbis
    Next
'Réaffichage à l'écran
Application.ScreenUpdating = True
End Sub

Dans ce cas :
*on n'insère plus une ligne à chaque fois, ce qui forcait à en supprimer une un peu plus loin dans le code,
* mais on stocke la plage B3: D8 dans Paquetbis, puis on colle directement B2: D2 (la plage Total) sur B8: D8, la dernière ligne du 1er paquet), et enfin Paquetbis en B2: D7 (Autrement dit, la ligne Total a été collée en bas, et Paquetbis a été décalé d'une ligne vers le haut). Et on recommence ainsi dans le second paquet, B10: D15 dans Paquetbis...

Une question pour répondre à ta dernière demande : Est-ce que tes tableaux sont très grands, ou non ? Autrement dit, est-ce qu'ils sont assez faciles à sélectionner ?

@ plus
 

Pièces jointes

  • Excel_Macro_Total3.xlsm
    26 KB · Affichages: 38
Dernière édition:

CISCO

XLDnaute Barbatruc
Re : Déplacer une ligne "Total" en dernière ligne d'un tableau

Bonsoir

Une possibilité en pièce jointe. A toi de tester. Tu sélectionnes n'importe quelle cellule d'un des tableaux que tu veux modifier, et tu lances la macro... et tu recommences sur un autre tableau à modifier. Et ainsi de suite.
Une condition pour que cela fonctionne bien : Il ne faut pas que les tableaux soient contiguës, il faut absolument une rangée de cellules vides autour.

@ plus
 

Pièces jointes

  • Excel_Macro_Total4.xlsm
    30.8 KB · Affichages: 44

CISCO

XLDnaute Barbatruc
Re : Déplacer une ligne "Total" en dernière ligne d'un tableau

Bonjour

En prenant en compte certaines simplifications données par paf sur un autre fil, le code de la macro devient plus simplement
Code:
Sub macro4()
Dim Paquetbis()
Dim i As Integer
Dim Premligne As Integer, Derligne As Integer
Dim Premcol As Integer, Derncol As Integer
Dim Paquetligne As Integer

Application.ScreenUpdating = False
ActiveCell.CurrentRegion.Select
Premligne = Selection.Row
Dernligne = Selection.Rows.Count + Premligne - 1
Premcol = Selection.Column
Derncol = Selection.Columns.Count + Premcol - 1
Paquetligne = Cells(Premligne + 1, Premcol).MergeArea.Rows.Count
    For i = Premligne To Dernligne - 1 Step Paquetligne
    If Cells(i + 1, Premcol + 1).Value <> "Total" Then Cells(i + 1, Premcol + 1).Select _
    : MsgBox "La première ligne de ce groupe, en " & Cells(i + 1, Premcol + 1).AddressLocal & ", ne contient pas le mot Total" _
    : Exit Sub
    Next
    For j = Premligne To Dernligne - 1 Step Paquetligne
    Paquetbis = Range(Cells(j + 2, Premcol + 1), Cells(j + Paquetligne, Derncol)).Value
    Range(Cells(j + 1, Premcol + 1), Cells(j + 1, Derncol)).Copy
    Cells(j + Paquetligne, Premcol + 1).PasteSpecial xlValue
    Range(Cells(j + 1, Premcol + 1), Cells(j + Paquetligne - 1, Derncol)) = Paquetbis
    Next
Application.ScreenUpdating = True
End Sub
@ plus
 

Pièces jointes

  • Excel_Macro_Total5.xlsm
    30.1 KB · Affichages: 36

CISCO

XLDnaute Barbatruc
Re : Déplacer une ligne "Total" en dernière ligne d'un tableau

Bonsoir

Une autre possibilité, peut être plus pratique pour toi.

Avec cette nouvelle version, tu n'as plus besoin de cliquer sur chacun des tableaux à "inverser" avant de lancer la macro. Cette nouvelle version reconnait automatiquement tous les mots "Total" placés sur la première ligne d'un paquet, et ne déplace la ligne correspondante que dans ce cas. Tu n'as donc qu'à lancer la macro, et à vérifier le travail fait.

@ plus
 

Pièces jointes

  • Excel_Macro_Total6.xlsm
    40.6 KB · Affichages: 36

CISCO

XLDnaute Barbatruc
Re : Déplacer une ligne "Total" en dernière ligne d'un tableau

Bonjour

En pièce jointe, une version fonctionnant presque comme la dernière.

Pour la lisibilité de l'ensemble, j'ai décomposé la macro en deux macros :
* la première, nommée Recherchelignetotalàinverser() faisant la recherche dans une boucle Do....Loop While des lignes comportant le mot total, et lançant automatiquement la macro ci-dessous si nécessaire (c-à-d lorsque le mot "Total" est dans la première ligne et dans la deuxième colonne du paquet)
* l'autre, Inverser() modifiant le paquet.

Par précaution, j'ai rajouté la condition en rouge ci-dessus, sous la forme And Premcol = Selection.Column - 1 pour ne pas avoir de problème avec des mots "Total", placés par ex dans P79 ou P87 ( le mot "Total" serait alors dans la première ligne du paquet correspondant (les 3 premières lignes uniquement), et l'ancienne macro aurait modifié ce paquet) (Dans ton ex, "Total" est en P80 et P88, dans la seconde ligne, donc il ni a pas de pb, mais, sait-on jamais...). Si cela te pose pb, il suffit de supprimer dans le code cette partie And... ci-dessus.

Bien sûr, c'est la première macro qu'il faut lancer.

@ plus
 

Pièces jointes

  • Excel_Macro_Total7.xlsm
    40 KB · Affichages: 40
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 247
Messages
2 086 582
Membres
103 247
dernier inscrit
bottxok