Suppression de lignes parmi plusieurs feuilles

Bonjour très cher(es),

Dans le cadre d'un projet, je suis confronté à un problème de suppression de lignes spécifiques dans différentes feuilles de calcul.

je m'explique, je dispose donc de deux feuilles de calcul "Personnel" et "Contrat" qui sont alimentées respectivement par les onglets "Personnel" et "Contrat" de l'userform crée à cette fin.

J'aimerai donc obtenir le résultat suivant: en supprimant un collaborateur dans la "listbox_Personnel" de l'onglet Personnel (ce qui le supprimera également dans la feuille "Personnel" qui lui est rattachée) que cela supprime automatiquement tous ses contrats dans la feuille "Contrats".

Pour plus de détails j'attache le fichier ci-après.

Je vous remercie avant tout pour votre aide.

Bonjour Ekoue09,

je n'aurai sans doute pas le temps ce matin mais, déjà, outre l'extraordinaire complexité de cette écriture, il n'y a pas de feuille 'AYANTS DROIT'!

Ça ne risque pas d'aller!

Set ADs = Worksheets("Ayants droit")

Je regarde dès que je peux!

A+

Bonjour curulis57,

Je vous remercie avant tout pour l'aide que vous m'accordez pour venir à bout de mon problème.

Oui, vous avez totalement raison, il n'y a pas de feuille excel "Ayants droit". Le classeur que je vous ai fourni n'est qu'une partie du véritable classeur sur lequel je travaille, et qui contient d'autres feuilles dont celle relative aux informations des Ayants-droit de chaque salarié.

Je viens de réadapter le programme de suppression comme suit:

 Private Sub Bouton_supprimer_personnel_Click()
    Dim acronymes, contrats As Range 'Variables RANGE
    Dim acronyme, contrat As Range 'Variables CELLULE

    Set acronymes = Worksheets("Personnel").Range("A3:" & Worksheets("Personnel").Range("A3").End(xlDown).Address)
    For Each acronyme In acronymes
        If acronyme.Value = ListBox_personnel.Value Then
            If MsgBox("Etes-vous certain de vouloir supprimer le contenu de " & Worksheets("Personnel").Range("E" & acronyme.Row).Value & " " & Worksheets("Personnel").Range("F" & acronyme.Row).Value & " ?", vbYesNo, "Demande de confirmation") = vbYes Then
                Sheets("Personnel").Select
                Rows(acronyme.Row & ":" & acronyme.Row).Delete
            End If
        End If
    Next acronyme

    Set contrats = Worksheets("Contrats").Range("J3:J" & Worksheets("Contrats").Range("J3").End(xlDown).Row)
    For Each contrat In contrats
        If contrat.Value = utilisateur_selection Then
            Sheets("Contrats").Select
            Rows(contrat.Row & ":" & contrat.Row).Delete
        End If
    Next AD

    MsgBox "Le contenu a bien été effacé"
End Sub 

Dans l'attente patiente de votre retour.

ReBonjour Curulis57,

Bonne nouvelle! En continuant les recherches de mon côté, je suis parvenu à une solution qui résout parfaitement mon problème et dont voici le code:

Private Sub Bouton_supprimer_personnel_Click()
'déclaration des variables
Dim compteur, D_ligne, P_ligne As Integer
dernligne_P = Worksheets("Personnel").Range("A" & Rows.Count).End(xlUp).Row 'Compte le nombre de ligne non vide dans "Personnel"
dernligne_c = Worksheets("Contrats").Range("A" & Rows.Count).End(xlUp).Row 'Compte le nombre de ligne non vide dans "Contrats"
compteur = 0
P_ligne = 0 'Première ligne comportant les informations du salarié
D_ligne = 0 'dernière ligne comportant les informations du salarié

Set Ens_personnel = Worksheets("Personnel")
Set ens_contrat = Worksheets("Contrats")

With Ens_personnel
    .Select
    For i = 3 To dernligne_P
        If .Cells(i, "A").Value = utilisateur_selection Then
            If MsgBox("Vous êtes sur le point de supprimer" & utilisateur_selection & " voulez-vous continuer ?", vbYesNo + vbExclamation, "Demande de confirmation") = vbYes Then
                Rows(i & ":" & i).Delete
                With ens_contrat
                .Select
                    For j = 3 To dernligne_c
                        If .Cells(j, "J") = utilisateur_selection Then
                        D_ligne = j
                        compteur = compteur + 1
                        End If
                    Next j
                    P_ligne = D_ligne - compteur + 1
                    On Error Resume Next
                    Rows(P_ligne & ":" & D_ligne).Delete
                End With
            End If
        End If
    Next i
End With
End Sub 

Toutefois, je reste persuadé qu'il existe une meilleure solution que la mienne pour obtenir le même résultat. Ainsi, je suis preneur de votre solution.

Je regarde cela en soirée, promis!

Cela demande un peu de tranquillité que la vie de famille ne me laisse pas pour l'instant!

A+

Bonsoir Ekoue,

voici ma procédure de suppression, comme promis!

Ton fichier mériterait un nettoyage en profondeur, non pas pour améliorer son fonctionnement (je n'ai pas cette prétention) mais pour faciliter sa maintenance en clarifiant le code!

• par exemple, ta variable 'utilisateur_selection', inutilement GLOBAL, à mon avis, gagnerait à s'appeler, autre exemple, 'sAcronyme' avec 's' pour string (c'est mon système, sans être le meilleur, sûrement, pour reconnaître la nature d'une variable).
• déclarer tes feuilles par 'Set wksP = WorkSheets("Personnel")', autre exemple, raccourcit le code et dégage la vue de ces énumérations interminables.
• et d'autres trucs encore...

A toi de voir!

Private Sub Bouton_supprimer_personnel_Click()
'
'déclaration des variables
Dim wksP, wksC As Worksheet
Dim rCel As Range
Dim iLig As Integer
'
Set wksP = Worksheets("Personnel")
Set wksC = Worksheets("Contrats")
'
iRowP = wksP.Range("A" & Rows.Count).End(xlUp).Row 'Compte le nombre de ligne non vide dans "Personnel"
iRowC = wksC.Range("A" & Rows.Count).End(xlUp).Row 'Compte le nombre de ligne non vide dans "Contrats"
'
'suppression du membre du personnel
Set rCel = wksP.Range("A3:A" & iRowP).Find(what:=utilisateur_selection, lookat:=xlWhole, searchdirection:=xlNext)
If MsgBox("Vous êtes sur le point de supprimer " & utilisateur_selection & " !" & Chr(10) _
    & "Confirmez-vous cette suppression ?", vbYesNo + vbExclamation, "Demande de confirmation") = vbYes _
    Then wksP.Rows(rCel.Row).Delete shift:=xlUp
'
'suppression des contrats
Set rCel = wksC.Range("J3:J" & iRowC).Find(what:=utilisateur_selection, lookat:=xlWhole, searchdirection:=xlNext)
For x = rCel.Row + 1 To iRowC
    If wksC.Cells(x, "J") <> utilisateur_selection Then
        iLig = x - 1
        Exit For
    End If
Next
wksC.Rows(rCel.Row & ":" & iLig).Delete shift:=xlUp
'
End Sub

Bon travail!

A+

Bonjour Curulis!

Comme quoi, on n'a jamais fini d'apprendre. Votre code marche de tonnerre! Il est parfaitement claire avec une bonne structure d'organisation.

Je garde jalousement vos conseils lors de l'écriture de mes prochains codes.

Je vous remercie infiniment de votre aide!

A+

Bonjour Curulis,

J'espère que vous allez bien depuis la dernière fois?

Je suis confronté à un petit soucis de fonctionnement avec la méthode "Find"

J'ai remarqué qu'il saute toujours la première cellule de la plage enregistrée et commence sa recherche à partir de la deuxième cellule de la plage spécialement pour les cas où l'information recherchée se retrouve sur les premières lignes. La première ligne est toujours oubliée. Par contre ce qui n'est pas le cas si l'information recherchée est sur la première ligne et de façon unique.

Oui je sais c'est assez confus tout ça.

Je m'explique prenons le code suivant:

 Set rCel = wksC.Range("J3:J" & iRowC).Find(what:=utilisateur_selection, lookat:=xlWhole, searchdirection:=xlNext) 

et le Salarié FRIPOUILLE Elioth qui est représenté de la ligne 3 à 5 comme le montre l'image ci-attachée.

Si je compile, rCel.Row me retourne à chaque fois la valeur 4 correspondant à la "ligne4" alors que la première information de FRIPOUILLE Elioth est enregistrée sur la "ligne3". Par contre, si on supprime les lignes 4 et 5 et qu'il ne reste plus que la ligne 3 relative aux informations de FRIPOUILLE Elioth alors rCel.Row retourne 3.

Du coup à chaque fois que j'exécute le code suivant:

wksC.Rows(rCel.Row & ":" & iLig).Delete shift:=xlUp

la première ligne demeure car cela revient à faire

wksC.Rows(4 & ":" 5).Delete shift:=xlUp

au lieu de

wksC.Rows(3 & ":" 5).Delete shift:=xlUp

Toutefois le problème ne se pose pas pour le reste des salariés dont les informations sont enregistrés dans les lignes suivantes.

J'espère que mon explication a pu vous éclairer sur mon soucis avec l'usage de la méthode "Find".

Bonjour Ekoue,

je ne parviens pas à ouvrir le fichier sur l'ordinateur domestique.

Donc, sans avoir testé ce qui suit, essaie peut-être de changer A3 et J3 par A2 et J2...

C'est la première chose que je voulais faire si le fichier s'était chargé.

A+

Bonjour Curulis,

Yess ça fonctionne avec A2 et J2. Problème résolu!

Sauf que je ne comprends toujours pas le fonctionnement de la méthode "Find" en prenant A3 et J3.

Avec A3 et J3, elle affiche le bon résultat dans les scénarios suivants:

• une seule et unique ligne contenant les informations du collaborateur sur la première ligne de la matrice
• Débuter la plage avec A2 et J2 dans le cas où le salarié est représenté dans les premières lignes de la matrice.

Dans le cas contraire rCel.Row retourne toujours "4" au lieu de "3" attendu.

Pour les prochaines utilisations de cette méthode, j'aimerais si possible connaître l'origine de ce problème sans trop abuser de votre temps.

Merci beaucoup!