Empêcher la suppression de la valeur si

Bonjour a tous,

Certains d'entre vous m'ont bien aidé pour réaliser le code ci dessous qui fonctionne à merveille. Par contre, j'aimerais ajouter la condition suivante :
Tant que le valeur recherchée est existant en feuil1 colonne "J", je ne peux pas supprimer cette valeur de la liste en feuil 2 colonne "G".

J'ai fais beaucoup d'essais main en vain .....je sèche ! ! !

Private Sub BtnSuppression_Click()
Dim entreprise As String
Dim ligne As Integer

Sheets("Liste").Select
If MsgBox("Confirme tu la suppression de cette ENTREPRISE ?", vbYesNo, "Demande de suppression de l'entreprise") = vbYes Then

ligne = Cells.Find(TxtEntrepriseRecherche.Value, , xlValues, xlWhole).Row 'correspond a la ligne recherchée

Range("G" & ligne & ":H" & ligne).Delete Shift:=xlUp ' permet de supprimer les cellules sélectionnées et de remonter vers le haut

Sheets("tableau de bord").Activate

End If

Merci par avance a tous de vos réponses.

2 réponses

  1. Contributeur
    Bonjour,

    a adapter:

    Sub test()
    Dim entreprise As String
    Dim ligne As Integer
    Dim Trouve As Range
     entreprise = InputBox("Entrez le nom de l'entreprise:", "Suppression")
    Set Trouve = Sheets("Feuil2").Columns(10).Cells.Find(what:=entreprise, LookAt:=xlWhole) 'colonne J à adapter le nom de la feuille
    'traitement de l'erreur possible : Si on ne trouve rien :
    If Trouve Is Nothing Then
        'ici, traitement pour le cas où la valeur n'est pas trouvée
        ligne = Cells.Find(entreprise, , xlValues, xlWhole).Row
    Range("G" & ligne & ":H" & ligne).Delete Shift:=xlUp
    Else
    MsgBox "Valeur presente: " & Trouve.Address
        Exit Sub
    End If
    End Sub

    0
    1. Bonjour Le Pivert,
      Votre code fonctionne parfaitement bien ! Félicitation.
      Mais je vais essayer de le modifier (c'est pas gagné), car je préférerais ne pas avoir l'inputbox.

      Merci beaucoup !
      0
      1. Contributeur
        C'est simple, il suffit de remplacer la variable entreprise par TxtEntrepriseRecherche

        Set Trouve = Sheets("Feuil2").Columns(10).Cells.Find(what:=TxtEntrepriseRecherche.Value, LookAt:=xlWhole) 'colonne J à adapter le nom de la feuille
        'traitement de l'erreur possible : Si on ne trouve rien :
        If Trouve Is Nothing Then
            'ici, traitement pour le cas où la valeur n'est pas trouvée
            ligne = Cells.Find(TxtEntrepriseRecherche.Value, , xlValues, xlWhole).Row


        Voilà

        @+
        0