Création de TCD avec plusieurs feuilles

petite question,

pourquoi y a t'il des lignes vides dans ton tableau ... c'est un import qui sort comme ça depuis un autre logiciel ?

de même pour ta ligne total ?

Bonjour,

En effet comme j'en avais parler en début de conversation mon tableau est un import depuis le logiciel de CAO/DAO nommé Revit. Impossible de supprimer ces lignes lors de l'import.

Ah ok ... effectivement .... faut faire avec alors ... je remets le nez dedans quand j'ai un peu de temps ... si d'ici là tu n'as pas trouvé ....

Je te remercie tu peut repartir du dernier fichier que j'ai mis en pièce jointe. C'est la version la plus avancée et la plus au point. En te rendant dans "00_ABAK_Synthese" tu auras deux boutons :

• Le premier est le code que tu m'avais envoyé plus tôt que j'ai retravaillé.

• Le second permet de supprimer mes lignes vierges, mes totaux et sous-totaux dans mon tableau de synthèse. Il fonctionne parfaitement sauf au moment où la boucle sort du tableau...

Ok

Essaie ça

Sub Mise_en_page_Tableau_synthese()
Dim montab As ListObject, dl As Integer, i As Integer

Set montab = ActiveSheet.ListObjects(1)
dl = montab.ListRows.Count

For i = dl To 2 Step -1

    If montab.ListRows(i).Range(1, 1).Value = "" Then
        montab.ListRows(i).Delete
    End If

Next

End Sub

Chez moi ça marche

Merci beaucoup pour cette aide précieuse.

J'avais moi aussi tenté de retravailler le code de mon côté.

J'espère que cette solution sera celle qui permettra de passer cette discussion en Résolu

Je n'ai pas accès à mon fichier dans la journée, je regarde donc dès ce soir.

Je reviens vers vous si besoin.

Encore merci.

Bonjour,

Une autre manière de supprimer des lignes dans un tableau.

Cdlt.

Public Sub DeleteRowsInTable()
Dim lo As ListObject, rng As Range, ur As Range, cell As Range
    Set lo = ActiveSheet.ListObjects(1)
    On Error Resume Next
    Set rng = lo.ListColumns(1).DataBodyRange.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If Not rng Is Nothing Then
        For Each cell In rng
            If ur Is Nothing Then
                Set ur = cell.Resize(, lo.ListColumns.Count)
            Else
                Set ur = Union(ur, cell.Resize(, lo.ListColumns.Count))
            End If
        Next cell
        ur.Delete
    End If
End Sub

Quel est l'avantage de cette méthode à part d'être un peu plus illisible ?

Re,

On ne supprime qu'une fois et pas x fois !...

Cdlt.

ah ok !

merci

Je viens de faire un test comparatif avec un timer sur chacune des méthodes, et ben il n'y a pas photo ...

je crois que je suis bon pour essayer de comprendre ton code, qui sort vainqueur haut la main

Serait-t-il éventuellement possible d'avoir le code de Jean-Eric commenté ?

En effet si son code est plus rapide cela peut s'avérer intéressant .

Quoi qu'il en soit je pense avoir deux solutions qui fonctionne à moi de choisir celle que je comprends la mieux.

Re,

La procédure initiale révisée (plus claire ?) avec des commentaire.

A te relire.

Cdlt.

Public Sub DeleteRowsInTable_2()
'Déclaration des variables
Dim TD As Range, Rng As Range, rUnion As Range, Cell As Range
    'Plage tableau avec en-têtes de ligne
    Set TD = ActiveSheet.ListObjects(1).Range
    On Error Resume Next
    'Plage colonne 1 avec cellules vides
    'Attention ! Retourne une erreur s'il n'y a pas de cellules vides
    Set Rng = TD.Columns(1).SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    'Si la colonne 1 du tableau comporte des celules vides
    If Not Rng Is Nothing Then
        'Pour chaque cellule vide
        For Each Cell In Rng
            'rUnion est l'union de 2 plages ou plus.
            'Resize redimensionne la plage spécifiée.
            If rUnion Is Nothing Then
                '1ère. ligne
                Set rUnion = Cell.Resize(, TD.Columns.Count)
            Else
                'Les lignes suivantes
                Set rUnion = Application.Union(rUnion, Cell.Resize(, TD.Columns.Count))
            End If
        Next Cell
        'Suppression des éléments en 1 fois
        rUnion.Delete
    End If
End Sub

Bonsoir,

Petit message pour vous remercier de votre aide et du temps que vous m'avez consacré.

Je vais pouvoir présenter un projet de qualité pour la fin de mes études.

Bon dernier message

J'ai une erreur lorsque je met les deux à la suite dans le même bouton :

Voici le message d'erreur rencontré :

et la ligne qui pose probleme :

Bonsoir,

Désolé pour ce message tardif mais j'ai réussi à trouver mon erreur.

Encore merci pour votre aide

de rien ... ça m'a permis de progresser aussi ... ( merci Jean-Eric )