donnée identique sur plusieurs feuilles et suppression des lignes ayant cette donnée

[fredoli]

Bonjour,

Je me permets de me joindre à votre forum car je suis totalement bloqué sur une macro pour mon boulot.
Explication de mon fichier:
J'organise un suivi pour gérer les bonus de plusieurs équipes d'une société slovaque.
J'ai donc organiser mon fichier Excel avec des feuilles totalement identiques.
Par exemple toutes les feuilles commençant par "P1" correspondent à une équipe, il y a 12 correspondant aux 12 mois de l'année. Ainsi de suite jusqu'à P6.
Chaque fois le mois de janvier est la feuille de référence pour les colonnes de A à G. si je change un nom sur P1 janvier les noms se changeront automatiquement jusqu'à P1 dec.

Explication de mon problème:
Lorsque je veux supprimer une personne, je dois supprimer la ligne entière par exemple sur "P1 janvier", mais je dois également supprimer cette même ligne sur tous les onglets commençant par "P1". Ainsi de suite si je suis sur P2 ...
J'ai deux solutions que j'ai fait sur l'onglet "P1 januar".
1er: "suppression ligne", mais malheureusement cela ne fonctionne que sur la feuille active et ne fait pas le reste.
2ème:"suppression personne", mais ma listbox ne se remplit pas des noms de la liste des personnes et je ne saurais pas faire la suppression des lignes comprenant un nom choisi dans onglet.

https://spreadsheets.google.com/ccc?key=0AvpW-YdmOopydDlTUW9RczdoQjhwNUZvWENKd19fR0E&hl=fr

Pourriez-vous m'aidez s'il vous plaît pour l'une ou l'autre solutions. Ou si vous avez une autre solution, vous m'enlèveriez une belle épine du pied.

Merci beaucoup par avance.

Bien cordialement.

Fredoli

 

[Hippolite]

Re : donnée identique sur plusieurs feuilles et suppression des lignes ayant cette do

Bonjour,
Sans fichier récupérable pour voir comment est la listbox, tu risques d'avoir peu de réponses.

A+

 

[fredoli]

Re : donnée identique sur plusieurs feuilles et suppression des lignes ayant cette do

Bonjour,

Déolé pour cette réponse tardive, un court séjour à l'hopital n'était pas prévu.
En effet sans fichier cela n'est pas très pratique.
Voici donc une fichier joint.

Merci par avance pour votre aide.

Cordialement.

Fredoli

 

[Hippolite]

Re : donnée identique sur plusieurs feuilles et suppression des lignes ayant cette do

Bonjour,

Voici une proposition pour des suppressions de lignes multifeuilles
Compatible avec des sélections multiples et non contigües
Toutes les lignes contenant la sélection seront supprimées
Une info Vrai/Faux est retournée pour un traitement éventuel.
Le nom de la feuille de synthèse de l'équipe est à modifier pour commencer par P#

Dans ta feuille2

Private Sub CommandButton1_Click()
    Supp Selection
    Exit Sub
End Sub

Dans ton module

Option Explicit
'Fonction compatible multi sélection, retourne Faux si annulé et Vrai si suppression effectuée
Function Supp(Target As Range) As Boolean 'permet de retourner l'info suppression exécutée ou non
    Dim TargetRows As Range, L As Range
    Dim i As Long
    Dim aSn As String, NomsLigne As String, t As String, SelFeuil() As String
    Dim w As WorkSheet
    Supp = False
    If Not Intersect(Target, Range("1:6")) Is Nothing Then
        MsgBox "Sélection incorrecte"
        Exit Function
    End If
    aSn = ActiveSheet.Name
    '.EntireRow doit être appliqué à une sélection adjacente pour éviter des anomalies avec certaines
    'versions d'Excel qui agissent de la première à la dernière ligne en incluant les trous, on va donc
    'travailler séparément sur chaque zone.
    Set TargetRows = Target.Areas(1) 'Initialise la première zone contigüe
    For i = 1 To Target.Areas.Count 'Boucle sur les zones non adjascentes
        Set TargetRows = Application.Union(TargetRows, Target.Areas(i).EntireRow) 'Réunion des lignes
    Next i
    NomsLigne = "|"
    For Each L In Intersect(TargetRows, Range("A:A"))
        For i = 1 To 5
            NomsLigne = NomsLigne & Cells(L.Row, i) & "|"
        Next i
        NomsLigne = NomsLigne & Chr(10) & "|"
    Next L
    If MsgBox("Chcete odstranit riadok ?" & vbCrLf & NomsLigne, vbYesNo, "odstranit raidok") = vbYes Then
        t = Left(ActiveSheet.Name, 2)
        i = 0
        For Each w In Worksheets 'Création matrice pour appeler les feuilles de l'équipe P#
            If Left(w.Name, 2) = t Then
            ReDim Preserve SelFeuil(i)
            SelFeuil(i) = w.Name
            i = i + 1
            End If
        Next w
        Sheets(SelFeuil).Select     'Sélection multi feuilles de l'équipe P#
        TargetRows.Select           'Sélection des lignes à supprimer
        Selection.Delete 'POUR LES TESTS mettre .Font.ColorIndex = 3
        Supp = True
        Sheets(aSn).Select 'Suppression de la sélection multifeuilles
    End If
End Function

Bon rétablissement
A+

 

[fredoli]

Re : donnée identique sur plusieurs feuilles et suppression des lignes ayant cette do

Bonjour,

Merci beaucoup pour ce grand coup de pouce, j'essaye dès ce matin car je dois mettre en appli ce fichier vendredi matin.
Je vous informe du résultat.

Merci encore.

Cordialement.

Fredoli.

 

[Hippolite]

Re : donnée identique sur plusieurs feuilles et suppression des lignes ayant cette do

Bonjour,
Deuxième solution "suppression personne" multisélection, qui fait appel à la fonction précédente.
Tu remplaces la ListBox par une ListView (multicolonne), au passage tu constateras que le MsgBox de confirmation de la fonction gagnerait à être remplacée par un UserForm avec Listview pour une meilleure présentation.
Tu ajoutes un troisième CommandButton "effacer la sélection" et tu mets le code suivant dans ton Userform :

'Option Explicit

Private Sub CommandButton1_Click()
    Dim LstItem As ListItem
    Dim i As Long
    Dim SelNoms As String, TTT As String
    'Vérifie qu'au moins une ligne est sélectionnée
    On Error Resume Next
    Set LstItem = ListView1.SelectedItem
    On Error GoTo 0
    If LstItem Is Nothing Then
        MsgBox "Aucune ligne n'est sélectionnée."
        Exit Sub
    End If
 
    'Boucle sur les lignes sélectionnées pour écrire la référence des noms sélectionnés
    For i = 1 To ListView1.ListItems.Count
    'Affiche le contenu (N°ligne) de la 1ere colonne pour chaque ligne sélectionnée
    If ListView1.ListItems(i).Selected = True Then
        TTT = "C" & ListView1.ListItems(i) 'Adresse de cellule contenant un nom sélectionné
        If SelNoms = "" Then
            SelNoms = TTT 'Initialisation avec la première adresse
        Else
            SelNoms = SelNoms & "," & TTT 'Ajout des autres adresses
        End If
    End If
    Next i
    Supp Range(SelNoms) 'Appel de la fonction suppression de lignes
    Unload Me
End Sub
 
Sub CommandButton2_Click()
    Unload Me
End Sub

Private Sub CommandButton3_Click()
    DeselectionneLvw1
End Sub

Private Sub UserForm_Initialize()
'    Dim i As Long, Dlign As Long
    Me.StartUpPosition = 1 'Centré
    '----- remplissage ListView------------------------
    With ListView1
        .MultiSelect = True     'Multicolonnes
        .FullRowSelect = True   'Sélection par ligne
        .LabelEdit = lvwManual  'Pas de modif manuelle dans la première colonne
        .Gridlines = False      'Pas de quadrillage
        .AllowColumnReorder = True 'Réorganisation des colonnes autorisé
        With .ColumnHeaders 'Définit le nombre de colonnes et Entêtes
            .Clear 'Supprime les anciens entêtes
            'Ajoute 3 colonnes en spécifiant le nom entête + largeur colonnes
            .Add , , "Ligne", 30
            .Add , , ActiveSheet.Cells(6, 1).Value, 40
            .Add , , ActiveSheet.Cells(6, 2).Value, 60
            .Add , , ActiveSheet.Cells(6, 3).Value, 50
        End With
        Dlign = ActiveSheet.Range("C6").End(xlDown).Row
        For i = 7 To Dlign
        .ListItems.Add , , ActiveSheet.Cells(i, 1).Row
        .ListItems(i - 6).ListSubItems.Add , , ActiveSheet.Cells(i, 1).Value
        .ListItems(i - 6).ListSubItems.Add , , ActiveSheet.Cells(i, 2).Value
        .ListItems(i - 6).ListSubItems.Add , , ActiveSheet.Cells(i, 3).Value
        Next i
        End With
        DeselectionneLvw1
'Spécifie l'affichage en mode "Détails"
    ListView1.View = lvwReport
'Par défaut, tri par nom
    ListView1.SortKey = 2
    ListView1.SortOrder = lvwAscending
    ListView1.Sorted = True
End Sub
  
 ' ------ Tri en cliquant sur l'en-tête d'une colonne ------
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    ListView1.Sorted = False
    ListView1.SortKey = ColumnHeader.Index - 1
    If ListView1.SortOrder = lvwAscending Then
        ListView1.SortOrder = lvwDescending
        Else
        ListView1.SortOrder = lvwAscending
    End If
    ListView1.Sorted = True
End Sub

Public Sub DeselectionneLvw1()
    Dim X As Long
    For X = 1 To ListView1.ListItems.Count
        ListView1.ListItems(X).Selected = False
    Next
    Set ListView1.SelectedItem = Nothing
End Sub

Private Sub UserForm_Terminate()
    Selection.Select 'Remet le focus sur la sélection
End Sub

Utilise abondament l'aide (touche F1)
n'hésite pas à poser des questions si tu ne comprends pas des lignes de code ou si tu rencontres un problème.

A+