Suppression de lignes sur plusieurs tableau

Bonjour,

Alors voila, Je dispose d'un tableau sauf qu'il peut m'arriver de supprimer du contenu de certaine ligne sauf que je souhaiterais qu'il en reste toujours une de disponible en bas et seulement une seule.

Je cherche donc une ligne VBA qui, à l'appuis sur un bouton supprimerais toutes les les lignes vide du tableau sauf celle en bas

Merci d'avance bizouille

Bonjour

Essayez ce code

Sub supprimer()
Dim lig As Byte
With ActiveSheet
    lig = .Range("B" & .Rows.Count).End(xlUp).Row
    If IsEmpty(.Range("B" & lig - 1)) Then Rows(lig).Delete
End With
End Sub

Si ok, merci de cliquer sur le v vert à coté du bouton EDITER pour cloturer le fil lors de votre réponse

Cordialement

Bonjour,

Une autre proposition pour ton sujet.

Cdlt.

Option Explicit

Public Sub Insert_Row_In_Table()
    With ActiveSheet
        .Unprotect
        .ListObjects(1).ListRows.Add
        .Protect userinterfaceonly:=True
    End With
End Sub

Public Sub Resize_Table()
Dim n As Double, rng As Range
    With ActiveSheet
        .Unprotect
        With .ListObjects(1)
            .Sort.SortFields.Add .ListColumns(1).DataBodyRange, xlSortOnValues, xlAscending
            .Sort.Apply
            .Sort.SortFields.Clear
            n = Application.Match(WorksheetFunction.Max(.ListColumns(1).Range), .ListColumns(1).Range, 0)
            Set rng = .Range.Resize(n, 3)
            .Resize rng
        End With
        .Protect userinterfaceonly:=True
    End With
    Set rng = Nothing
End Sub

Merci Jean Eric cela m'a avance. Cependant, je n'arrive pas a comprendre ta ligne et je souhaiterais l'amélioré je vais donc te décrire plus précisément ma fonction comme elle sonne dans ma tête

Voire PJ

SI dans mon tableau, deux cellules côte a côte de la colonne 2 et 3 sont vide ("Cellules bleu")

ALORS suprimer le contenu de la ligne correspondante ("Cellules verte")

ET suprimer la ligne correspondante ("Cellule encadré rouge")

bonjour

il est inutile (et parfois nuisible car on perd un historique) de supprimer des lignes dans un tableau

on peut à volonté le filtrer si besoin.

pourquoi faire compliqué ?

edit : salut Jean-Eric

Peut être parce que des fois nous n'avons pas le choix dans nos projet :/

Il faut des fois laisser parler sa créativité au débit des autres petit soucis engendré ^^

re

il n'est pas question de créativité mais d'informatique basique.

si tu veux du fiable et durable il faut faire simple, le plus simple possible

bon, je connais aussi pas mal de patrons qui, n'ayant qu'une connaissance d'Excel limitée à =1+1 exigent qu'on leur fasse un dév à l'aspect pro, oubliant qu'aucun progiciel n'est basé sur un tableur

re

explication : je vois de nombreux dev en entreprise qui ont été faits jolis ET compliqués parce que le patron a imposé "je veux comme ceci et comme cela". Mais il est nul en Excel et donc le résultat est complexe et ne fonctionne pas bien.

c'est ce qui t'arrive puisque tu dis "nous n'avons pas le choix dans nos projet"

Bonjour,

Une proposition à étudier.

Cdlt.

Public Sub Delete_Rows_In_Table2()
Dim ws As Worksheet
Dim lo As ListObject
Dim rng As Range, rng2 As Range
Dim LR As ListRow
Dim lCol As Long, lRow As Long
Dim N As Double
    Application.ScreenUpdating = False
    Set ws = ActiveSheet
    Set lo = ws.ListObjects(1)
    If lo.DataBodyRange Is Nothing Then exit_Handler
    lCol = lo.ListColumns.Count: lRow = lo.ListRows.Count
    Set rng = lo.Range.Offset(, 1).Resize(lRow, lCol - 1).SpecialCells(xlCellTypeBlanks)
    If rng Is Nothing Then GoTo exit_Handler
    Set rng = Nothing
    For Each LR In lo.ListRows
        Set rng = LR.Range.Offset(, 1).Resize(1, lCol - 1)
        N = WorksheetFunction.CountA(rng)
        If N = 0 Then
            If rng2 Is Nothing Then
                Set rng2 = LR.Range
            Else
                Set rng2 = Union(LR.Range, rng2)
            End If
        End If
    Next LR
    'ws.Unprotect
    rng2.Delete
    'ws.Protect userinterfaceonly:=True
    Set rng2 = Nothing: Set rng = Nothing
exit_Handler:
    Set lo = Nothing
    Set ws = Nothing
End Sub

Ouai Ce n'est pas entièrement faux JMD

Jean Eric : non code me dit : Erreur de compilation , Sub ou fonction non defini; au niceau de "Exit-Handler"

Merci

Re,

Ajoute le Goto dans la procédure :

If lo.DataBodyRange Is Nothing Then GoTo exit_Handler

Et bien écoute parfait après plusieurs essaie, cela a l'air de marcher.

Merci énormément pour ton temps.

Re,

Pense à clore le sujet.

Cdlt.

j'ai en réalité détecter une petite erreur. En effet, si le tableau n'a pas de ligne vide, la fonction se met en erreur. La solution la plus simple que j'ai trouver, c'est d'insérer une ligne avant par se fait il y a toujours une ligne a effacer quoi qu’il arrive

CDLT

RE,

En fin de procédure, modifie ainsi :

If Not rng2 Is Nothing Then
        rng2.Delete
        Set rng2 = Nothing
    End If

Parfait c'est bien ça est serais tu quoi modifier pour que se code s'applique a plusieurs tableau d'une page et pas seulement 1

Merci

edit

Bonjour,

Une proposition à tester.

Cdlt.

Option Explicit

Public Sub Delete_Rows_In_Multiple_Tables()
Dim lo As ListObject
Dim rng As Range, rng2 As Range
Dim LR As ListRow
Dim lCol As Long, lRow As Long
Dim N As Double
    Application.ScreenUpdating = False
    For Each lo In ActiveSheet.ListObjects
        If Not lo.DataBodyRange Is Nothing Then
            lCol = lo.ListColumns.Count: lRow = lo.ListRows.Count
            Set rng = lo.Range.Offset(, 1).Resize(lRow, lCol - 1) _
                      .SpecialCells(xlCellTypeBlanks)
            If Not rng Is Nothing Then
                Set rng = Nothing
                For Each LR In lo.ListRows
                    Set rng = LR.Range.Offset(, 1).Resize(1, lCol - 1)
                    N = WorksheetFunction.CountA(rng)
                    If N = 0 Then
                        If rng2 Is Nothing Then
                            Set rng2 = LR.Range
                        Else
                            Set rng2 = Union(LR.Range, rng2)
                        End If
                    End If
                    Set rng = Nothing
                Next LR
                If Not rng2 Is Nothing Then
                    rng2.Delete
                    Set rng2 = Nothing
                End If
            End If
        End If
    Next lo
End Sub

Ça marche en revanche presque le même problème que précédemment. Si il n'y a pas de cellules de vide il me met un message avec "pas de cellules correspondante" et l'erreur me ramène a la ligne précédente :

Set rng = lo.Range.Offset(, 1).Resize(lRow, lCol - 1) _

.SpecialCells(xlCellTypeBlanks)