Supprimer une ligne d'un tableau selon la valeur d'une cellule sous VBA (sans supprimer les lignes au dessus)

[MaDesn]

Bonjour à tous !

Je suis en plein dans la finalisation d'un classeur excel pour aider d'autres personnes à organiser l'écriture de leurs romans. J'ai un léger problème sur une de mes macros qui vise à supprimer une fiche personnage créee par l'utilisateur. Tout ce passe bien sur 90% de la macro, sauf à un moment tout bête. Dans une de mes feuilles, j'ai un tableau avec la liste des fiches personnages que l'utilisateur a créé (ce tableau m'est utile pour créer des validations de données en liste, mais là n'est pas le souci). Je vous joints une photo du tableau (Tableau 3 qui se trouve dans la feuille "Liste personnage", sachant que l'utilisateur appuie sur un bouton déclenchant la macro dans la feuille "Personnages").

Voici le code dans son intégralité qui marche :

Sub DelPerso()

Dim i As Integer
 Dim wb As Workbook
    Set wb = ActiveWorkbook
    Set wh = Worksheets(ActiveSheet.Name)

Sheets("Personnages").Select

   If wh.Range("D29").Value <> "" Then
  
Sheets("Personnages").Select
     Range("D30").Select
      Selection.Copy
    Range("D31").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Application.DisplayAlerts = False
Worksheets(Range("D31").Value).Delete
Application.DisplayAlerts = True
  
   Sheets("Liste personnage").Select

With ThisWorkbook.Sheets("Liste personnage")
            For i = .Range("E" & .Rows.Count).End(xlUp).Row To 2 Step -1
'je travaille sur la colonne E car mes feuilles correspondant aux fiches personnages sont nommées d'après E
'Rows.count permet de retourner le nombre de ligne de la plage range
                        If .Range("E" & i).Value = Sheets("Personnages").Range("D31").Value Then
                                    Range("A" & i & ": E" & i).Select
    Selection.ListObject.ListRows(1).Delete
                                  
                        End If
            Next i
End With

Sheets("Personnages").Select
Range("D29").Select
       Selection.ClearContents

 Else
      
    Sheets("Personnages").Select
Range("D29").Select
MsgBox "Indique le nom du personnage ou de la fiche personnage que tu souhaites supprimer."
    
    End If


End Sub

Donc, quand l'utilisateur appuie sur la macro pour supprimer la fiche personnage, la feuille correspondante se supprime sans souci et dans le cas où le nom de la fiche personnage (dans le tableau 3) se trouve en première position, je n'ai également aucun problème, la ligne correspondante se supprime parfaitement. Mais, dans le cas où le nom de ma fiche personnage se trouve un peu plus bas dans le tableau (par exemple en ligne 3 ou 4), ce sont toutes les lignes au dessus de lui et lui compris qui sont supprimés et non seulement lui. Mais par contre, le reste de la macro fonctionne bien.

Voici en particulier, le bout du code qui ne marche pas lorsque la donnée recherchée n'est pas la première du tableau :

With ThisWorkbook.Sheets("Liste personnage")
            For i = .Range("E" & .Rows.Count).End(xlUp).Row To 2 Step -1
'je travaille sur la colonne E car mes feuilles correspondant aux fiches personnages sont nommées d'après E
'Rows.count permet de retourner le nombre de ligne de la plage range
                        If .Range("E" & i).Value = Sheets("Personnages").Range("D31").Value Then
                                    Range("A" & i & ": E" & i).Select
    Selection.ListObject.ListRows(1).Delete
                                  
                        End If
            Next i
End With

Pouvez-vous m'aidez à comprendre ce qui ne va pas ? Je suis encore une novice sur vba. Merci d'avance !

 

[cp4]

Bonjour MaDesn,

Si j'ai bien compris, tu veux supprimer la ligne de la cellule sélectionnée.
Evite les Select/Selection ça ralenti le code

'au lieu de cette écriture'
Sheets("Personnages").Select
Range("D29").Select
       Selection.ClearContents
'celle-ci est beaucoup mieux'   
Sheets("Personnages").Range("D29").ClearContents

Essai ce code pour supprimer ta ligne

Sub supprimerLigneActive()
With ThisWokbook.Sheets("Liste personnage")
    .ActiveCell.EntireRow.Delete
End With
End Sub

 

[Rouge]

Bonjour,

Autre proposition:

    With ThisWorkbook.Sheets("Liste personnage")
        For i = .Range("E" & .Rows.Count).End(xlUp).Row To 2 Step -1
            If .Range("E" & i).Value = Sheets("Personnages").Range("D31").Value Then .Range("A" & i & ": E" & i).ListObject.ListRows(1).Delete
        Next i
    End With

Cdlt

 

[MaDesn]

Oh je vais essayer vos deux méthodes ce soir, je vous fait un retour dès que je l'ai fait, encore merci !

 

[MaDesn]

Alors, je viens de tester le code de Rouge et mon problème n'a pas disparu. Une autre ligne a été supprimée en plus de celle demandée :

Aussi, en regardant le code de cp4, je n'ai pas l'impression que c'est ce qui marcherait le mieux, parce que :
- L'utilisateur n'a pas accès au tableau 3. Il rentre dans une case le nom de la fiche qu'il veut supprimer et toutes les informations sur cette fiche (dont sa ligne dans le tableau 3) sont supprimés, donc on ne travaille avec une cellule active directement dans le tableau
- Mon tableau n'est pas le seul élément de la feuille "Fiche personnage", je ne peux donc pas supprimer la ligne entière mais seulement la ligne du tableau. S'il n'existe aucune solution pour ce problème, je peux faire en sorte d'isoler le tableau sur une autre feuille, mais c'était pour éviter de surchager le classeur

Par contre, je vais essayer ta manière d'écrire les codes cp4 pour alléger mes macros !

 

[Rouge]

Bonjour,

Avec une capture d'écran, on ne peut pas tester réellement à moins de tout refaire.
Si vous pouviez déposer un fichier (sans données confidentielles), vous obtiendriez rapidement une réponse adéquate.

Cdlt

 

[MaDesn]

Oui bien sûr ! Voici une version très très édulcorée de mon classeur, mais avec tous les éléments essentiels pour faire fonctionner la macro :

 

[Rouge]

Bonjour,

Maintenant je comprends mieux, la feuille "Liste personnage" est sous la forme d'un tableau structuré, Ce dernier englobe toutes les colonnes, et vous voulez supprimer uniquement les données comprises entre A et D, chose impossible, par contre vous pouvez effacer simplement les données entre A et E.

Si vous souhaitez malgré tout supprimer cette partie, alors il faut repasser le tableau structuré en plage.

Cdlt

 

[MaDesn]

Il doit y avoir un souci dans ce que je t'ai envoyé, je veux effectivement bien supprimer la ligne entière du tableau, donc de A à E

 

[Rouge]

Visiblement on ne s'est pas compris, dans la feuille "Liste personnage" , quelle est la dernière colonne?

Le tableau structuré "Tableau3", englobe -t-il cette dernière colonne? si c'est le cas la ligne entière ne s'arrête pas à E mais à cette dernière colonne, donc on ne peut pas supprimer qu'une partie de la ligne comprise entre A et E, tout ce qui suit derrière sera supprimé.

Par contre, si le tableau structuré s'arrête à la colonne E, et qu'il y a encore des données dans les autres colonnes, lors de la suppression de la ligne, toutes les données des autres colonnes ne seront plus en phase avec celles du tableau 3, tout sera décalé. Est-ce plus clair?

 

[MaDesn]

Le tableau 3 va de la colonne A à E, les autres colonnes de la feuille sont hors du tableau 3. Ce que je souhaite supprimer, c'est donc la ligne correspondant au nom de mon personnage allant de A à E, sans que cela perturbe le reste de la feuille. Si ce n'est pas possible, la tableau 3 peut être isolé sur une feuille à part entière, mais l'important est que la macro supprime seulement la ligne demandé et pas les lignes du dessus

 

[Rouge]

Je viens de voir quelque chose,

Dans votre fichier en exemple, les noms des personnages dans la colonne E, sont différents par rapport à la cellule D29 (pas l'espace avant le N°).

Après correction, voici

Sub Supprimerpersonnage()
    Dim i As Long
    Dim f1 As Worksheet, f2 As Worksheet
    Dim Perso As String
    
    Set f1 = Sheets("Personnages")
    Set f2 = Sheets("Liste personnage")
    Perso = f1.Range("D29").Value
    If Perso <> "" Then
        f2.Select
        With f2
            DerLig = .ListObjects("Tableau3").DataBodyRange.Rows.Count
            Set x = .ListObjects("Tableau3").DataBodyRange.Columns(5).Find(Perso, LookAt:=xlWhole)
            If Not x Is Nothing Then
                .Range(Cells(x.Row, "A"), Cells(x.Row, "E")).ListObject.ListRows(2).Delete
            End If
        End With
        f1.Range("D29").Value = ""
    Else
        f1.Range("D29").Select
        MsgBox "Indique le nom du personnage ou de la fiche personnage que tu souhaites supprimer."
    End If
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Cdlt

 

[MaDesn]

Oui c'est normal, je l'ai expliqué dans le fichier. Même si la personne entre un nom avec un espace, c'est le nom sans espace (en E dans le tableau 3) qui devient le nom de la fiche personnage pour qu'une autre formule marche sans souci. Ce nom sans espace est généré en D30, puis copier valeur en D31 pour finalement être mis en E2

 

[MaDesn]

Tu crois que je peux adapter ton code pour qu'il me cherche la valeur D31 en E ? Ou la valeur D29 en A ?

 

[MaDesn]

C'est bon Rouge ! Je viens de tester ta macro en indiquant que l'on cherche dans la colonne 1 et tout fonctionne parfaitement ! Encore merci !

Pour ceux que cela intéresse, voici le code dans sa globalité

Sub Supprimerpersonnage()
    Dim i As Long
    Dim f1 As Worksheet, f2 As Worksheet
    Dim Perso As String
    
    Set f1 = Sheets("Personnages")
    Set f2 = Sheets("Liste personnage")
    
    
    Perso = f1.Range("D29").Value
    
    If Perso <> "" Then
    
  f1.Range("D30").Select
      Selection.Copy
    f1.Range("D31").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
        f2.Select
        
        With f2
        
            DerLig = .ListObjects("Tableau3").DataBodyRange.Rows.Count
            Set x = .ListObjects("Tableau3").DataBodyRange.Columns(1).Find(Perso, LookAt:=xlWhole)
            If Not x Is Nothing Then
                .Range(Cells(x.Row, "A"), Cells(x.Row, "E")).ListObject.ListRows(2).Delete
                
            End If
        End With
        
    f2.Range("D4").Select
    Selection.Copy
    f2.Range("D3").Select
    ActiveSheet.Paste
        
   Sheets("Personnages").Select
Application.DisplayAlerts = False
Worksheets(Range("D31").Value).Delete
Application.DisplayAlerts = True
        
        f1.Range("D29").Value = ""
        
    Else
    
        f1.Range("D29").Select
        MsgBox "Indique le nom du personnage ou de la fiche personnage que tu souhaites supprimer."
        
    End If
    Set f1 = Nothing
    Set f2 = Nothing
    
End Sub