XL 2013 Garder espace de 1 ou 2 ligne(s) entre tableaux structurés sur une même feuille

[Leguyl]

Bonjour à tou(te)s,

Dans mon fichier de travail, j'ai une feuille contenant 6 petits (2 à 20 lignes) tableaux structurés l'un en dessous de l'autre, chacun accueillant certaines données provenant d'autres tableaux. L'idéal serait sans doute de les placer dans des feuilles différentes mais qu'ils soient l'un sous l'autre est une exigence du boulot.

Au départ, pour plus de clarté lors de l'impression, j'avais 2 lignes espaçant chacun de ces tableaux. Le souci est que, lorsque je les réinitialise, chacun remonte bien sûr vers le précédent et quand j'importe les nouvelles données, chaque tableau s'étend jusqu'au suivant avant de le repousser plus bas et il n'y a donc plus de lignes vides entre eux.

Est-il possible, à l'aide de VBA ou autre, de remédier à cela ?

Merci d'avance,
Leguyl

 

[Robert]

Bonjour Leguyl, bonjour le forum,

Peut-être comme ça :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim I As Integer 'déclare la variable I (Incrément)

Set O = Worksheets("Feuil1") 'définit l'onglet O (à adapter à ton cas)
For I = O.ListObjects.Count To 1 Step -1 'boucle inversée sur tous les tableaux structurés de l'onglet O
    Rows(O.ListObjects(I).HeaderRowRange.Row).Insert 'insère une ligne avant la ligne d'en-tête du tableau structuré de la boucle
Next I 'prochain tableau structuré de la boucle
End Sub

 

[Leguyl]

Bonjour Robert. Merci bien, ça marche

 

[Leguyl]

Oups je n'avais pas vu que le premier tableau descend d'une ligne, lui aussi. Logique.

J'ai juste dû ajouter ceci à la fin du code :

    Rows("1:1").Select
    Selection.Delete Shift:=xlUp

Bonne journée,
Leguyl

 

[fanch55]

Bonjour,

Au départ, pour plus de clarté lors de l'impression, j'avais 2 lignes espaçant chacun de ces tableaux. Le souci est que, lorsque je les réinitialise, chacun remonte bien sûr vers le précédent

Je suis surpris : si vous faites un clear des tableaux, les lignes de séparation ne sont pas détruites

 

[Leguyl]

Bonjour,


Je suis surpris : si vous faites un clear des tableaux, les lignes de séparation ne sont pas détruites

Non, en effet pas au moment du clear. Mais lorsqu'on importe de nouvelles données, le tableau du dessus s'étend d'abord jusqu'à "toucher" celui en dessous avant de le repousser vers le bas.

J'avais oublié de préciser que lorsque je réinitialise les tableaux, il ne s'agit pas simplement d'effacement du contenu mais chacun est ramené à une seule ligne. Et lorsque j'importe de nouvelles données, ils s'étendent sur plusieurs lignes pour les contenir toutes.

 

[Leguyl]

Re bonjour à tou(te)s,

Je n'avais pas remarqué tout de suite que le dernier des six tableaux descend lui aussi d'une ligne supplémentaire à chaque fois que je réimporte des données et là, je ne sais comment faire pour garder une seule ligne (deux max) avant celui-ci.

C'est simple de supprimer la première ligne de la feuille après que le premier tableau soit descendu mais comment faire pour le dernier tableau, qui ne commence pas toujours à la même ligne ?

Il doit y a un truc que je n'ai pas compris dans le mécanisme.

 

[Leguyl]

Bonjour à tou(te)s,

Je coince toujours sur ce souci. Avec la solution adoptée, le dernier tableau s'éloigne d'une ligne supplémentaire après chaque importation de données et je sui obligé de le sélectionner et le remonter manuellement.

J'aimerais comprendre comment garder une seule ligne (ou deux max) de séparation entre tous les tableaux, du premier au dernier inclus.

Bonne journée.

 

[eriiic]

Bonjour à tous,

En reprenant le code de Robert :

Sub Macro1()
    Dim O As Worksheet 'déclare la variable O (Onglet)
    Dim I As Integer 'déclare la variable I (Incrément)

    Set O = Worksheets("Feuil1") 'définit l'onglet O (à adapter à ton cas)
    For I = O.ListObjects.Count To 2 Step -1 'boucle inversée sur tous les tableaux structurés de l'onglet O
        If Not O.ListObjects(I).HeaderRowRange(1).Offset(-1).ListObject Is Nothing Then
            ' si la cellule au-dessus appartient à un tableau
            Rows(O.ListObjects(I).HeaderRowRange.Row).Insert 'insère une ligne avant la ligne d'en-tête du tableau structuré de la boucle
        End If
    Next I 'prochain tableau structuré de la boucle
End Sub

eric

 

[Leguyl]

Merci bien Eric, ça marche.

Les commentaires que Robert et vous avez insérés dans le VBA m'aide à comprendre le cheminement, ça aide vraiment beaucoup. Encore merci à tous les deux.

Bonne journée,
Leguyl

 

[fanch55]

Bonjour,

La macro d'Eric fonctionne mais ne garantit pas que le tableau ignoré soit celui en tête de feuille, de plus il faudra faire un clearformat de la ligne insérée ..

Si les lignes inter-tableaux sont "supprimées" ,
c'est que vous faites un copier/coller basique de données dans le tableau .

Il serait préférable d'utiliser le mécanisme préconisé pour un tableau structuré :
Insérer au préalable autant de lignes dans le tableau que de lignes à y coller .

Ceci garantira que les lignes inter-tableaux soient conservées,
d'autant plus que vous aviez pu y mettre des infos ...

Voir exemple ci-joint

 

[Leguyl]

Bonjour fanch55,

Et merci pour votre solution.

Toutes les données n'étant pas utiles à l'import, je n'importe qu'une partie des nombreuses colonnes des tableaux sources.

Puis lorsque la valeur dans une cellule de la colonne "Nb" est vide ou de 0, je supprime la ligne entière.

Exemple, pour le premier tableau :

Sub ImportAtelier()

    Application.ScreenUpdating = False

    Sheets("Coût pièces").Range("TabPièces[[Coul.]:[Largeur2]").Copy
    Sheets("Bon atelier").Range("TabAtelierPces[Coul.]").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
 
    Sheets("Coût pièces").Range("TabPièces[[Haut.1]:[Nb]]").Copy
    Sheets("Bon atelier").Range("TabAtelierPces[Haut.1]").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    Sheets("Coût pièces").Range("TabPièces[[Durée MO]:[Durée totale]]").Copy
    Sheets("Bon atelier").Range("TabAtelierPces[Durée MO]").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    Call SupprLignesVidesPcesAtelier

Sub SupprLignesVides0PcesAtelier()

    Dim PL As Range 'déclare la variable PL
    Dim I As Integer 'déclare la variable I
    
    Set PL = Range("TabAtelierPces[Nb]") 'définit la plage PL
    For I = PL.Rows.Count To 1 Step -1 'boucle de la dernière a la première ligne de PL
        If PL(I).Value = 0 Then PL.ListObject.ListRows(I).Delete 'si la valeur est nulle, supprime la ligne
    Next I 'prochaine ligne de la boucle

End Sub

Le nombre de lignes des tableaux sources pouvant varier selon les données ajoutées ou retirées, le nombre de lignes des tableaux dans lesquels les données sont importées varient aussi. Il m'est donc difficile de déterminer combien je devrais insérer de lignes vides dans les tableaux. De plus, je n'ai pas les mains libres pour faire ce que je veux.

J'utilise, pour le moment, la méthode que je maîtrise le mieux, même si elle n'est pas idéale, car je dois avancer mais je garde la votre sous le coude.

 

[fanch55]

On peut toujours savoir ce qu'on va copier :
Le code fourni peut être traduit en :

Sub test()
Dim TbIn As ListObject, TbTo As ListObject
Application.ScreenUpdating = False

    Set TbIn = [TabPièces].ListObject
    Set TbTo = [TabAtelierPces].ListObject
    
    If Not TbTo.DataBodyRange Is Nothing Then TbTo.DataBodyRange.Delete
    For I = 1 To TbIn.DataBodyRange.Rows.Count
        If Val(TbIn.ListColumns("Nb").DataBodyRange.Rows(I)) > 0 Then
            TbTo.ListRows.Add: R = TbTo.ListRows.Count
            For Each Col In Array("Coul.", "Largeur2", "Haut.1", "Nb", "Durée MO", "Durée totale")
                TbTo.ListColumns(Col).DataBodyRange.Rows(R).Value = TbIn.ListColumns(Col).DataBodyRange.Rows(I).Value
                TbTo.ListColumns(Col).DataBodyRange.Rows(R).NumberFormat = TbIn.ListColumns(Col).DataBodyRange.Rows(I).NumberFormat
            Next
        End If
    Next

End Sub

 

[Leguyl]

Bonjour fanch55,

Je tenterai d'adapter votre code à mon fichier de travail fin de semaine, en ce moment je suis déjà sur autre chose en parallèle.

Je ne manquerai pas de vous faire savoir si j'ai pu faire cette adaptation et si ça marche.

Encore merci et bonne journée,
Leguyl