Microsoft 365 Effacer une même plage de cellule sélectionnée sur plusieurs feuille

[ShrekL]

Bonjour,

Il semble ue j'ai un petit bug dans ma commande me servant à effacer une même plage de cellule sélectionnée sur plusieurs feuille. Voici mon code :

Sub Effacer_ligne()
'
' Effacer les lignes sélectionnées

'   Définir les feuilles par les no de feuil
    Pages = Array(Feuil3.Name, Feuil5.Name, Feuil8.Name, Feuil10.Name)
'   Définir les rapports par les no de feuil
    rapp = Array(Feuil5.Name, Feuil8.Name, Feuil10.Name)

'   Définir la variable x
    For Each x In Pages
    
'   Enlever la protection des feuilles
        Sheets(x).Unprotect
        Next x

'   Définition des variables
    Dim rng1 As Range
    Set rng1 = Selection.EntireRow
    
    Range(rng1.Address).Delete

'   DANS LES RAPPORTS
    
'   Définir la variable y
    For Each y In rapp

    Sheets(y).Range(rng1.Address).Delete

    Next y
    
    Cells(ActiveCell.Row, 1).Select
    ActiveCell.Offset(-2, 0).Copy
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    
    For Each x In Pages
    Sheets(x).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True
    
    Next x

End Sub

Le bug se produit à la ligne " Sheets(y).Range(rng1.Address).Delete" lorsque je veux effacer les lignes dans les autres feuilles.

Il doit y avoir un moyen d'effacer cette plage sans sélectionner ou activer ces feuilles?

Merci et salutations,

 

[Phil69970]

Bonjour @ShrekL

Je te propose ceci avec plein de questions

Sub suppr()

Pages = Array(Feuil3.Name, Feuil5.Name, Feuil8.Name, Feuil10.Name)      '   Définir les feuilles par les no de feuil
rapp = Array(Feuil5.Name, Feuil8.Name, Feuil10.Name)                             '   Définir les rapports par les no de feuil

'***********??????
'Pourquoi enlever les protections sur des feuilles ou tu ne vas pas aller ???????
'****************
For Each x In Pages
    Sheets(x).Unprotect                                                 '   Enlever la protection des feuilles
Next x
'****************
'***********?????


MaLigne = ActiveCell.Row

'   DANS LES RAPPORTS
For Each y In rapp
    Sheets(y).Rows(MaLigne).EntireRow.Delete                            '   Suppression de la ligne dans toutes les feuilles de l'aarray rapp
Next y

'********** ????????????????
'**********
' Que viennent faire ces lignes ici si tu es dans une procédure de suppression pourquoi tu fais de la copie
' Dis autrement que cherches tu as faire ici copier quoi sur quelles feuilles etc .....

Cells(ActiveCell.Row, 1).Select
ActiveCell.Offset(-2, 0).Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False

'**************
'**************??????????????

For Each x In Pages
    Sheets(x).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
        AllowFormattingColumns:=True, AllowFormattingRows:=True         '   Remets la protection des feuilles
Next x
End Sub

*Merci de ton retour

@Phil69970

 

[ShrekL]

Bonjour @ShrekL

Je te propose ceci avec plein de questions

Sub suppr()

Pages = Array(Feuil3.Name, Feuil5.Name, Feuil8.Name, Feuil10.Name)      '   Définir les feuilles par les no de feuil
rapp = Array(Feuil5.Name, Feuil8.Name, Feuil10.Name)                             '   Définir les rapports par les no de feuil

'***********??????
'Pourquoi enlever les protections sur des feuilles ou tu ne vas pas aller ???????
'****************
For Each x In Pages
    Sheets(x).Unprotect                                                 '   Enlever la protection des feuilles
Next x
'****************
'***********?????


MaLigne = ActiveCell.Row

'   DANS LES RAPPORTS
For Each y In rapp
    Sheets(y).Rows(MaLigne).EntireRow.Delete                            '   Suppression de la ligne dans toutes les feuilles de l'aarray rapp
Next y

'********** ????????????????
'**********
' Que viennent faire ces lignes ici si tu es dans une procédure de suppression pourquoi tu fais de la copie
' Dis autrement que cherches tu as faire ici copier quoi sur quelles feuilles etc .....

Cells(ActiveCell.Row, 1).Select
ActiveCell.Offset(-2, 0).Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False

'**************
'**************??????????????

For Each x In Pages
    Sheets(x).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
        AllowFormattingColumns:=True, AllowFormattingRows:=True         '   Remets la protection des feuilles
Next x
End Sub

*Merci de ton retour

@Phil69970

Bonjour Phil... encore merci pour ton aide. Malheureusement cela ne fonctionne pas car la variable Maligne=ActiveCell efface une seule ligne (celle de la cellule active) alors que ce que je veux c'est effacer plusieurs lignes sélectionnées par l'utilisateur.

En gros, j'aurais p-e due simplement demander pourquoi la variable rng1 = Selection.EntireRow.Delete ne fonctionne pas sur des pages autres que celle active et comment puis-je contourner ce problème?

Pour les autres questions, voici un peu les réponses :
- La protections était désactivée jusqu'à maintenant car, avant aujourd'hui, j'activais les feuilles afin d'effacer les lignes et cela ne fonctionnait pas lorsque les feuilles étaient protégées. Lorsque le code fonctionnera, j'essayerai sans cette étape que j'aimerais bien éliminer effectivement.
- La copie de la cellule à la fin c'est parce que sur ma feuille active, mes lignes sont numérotées avec un numéro d'item. Chaque no d'item ligne est relative à la ligne précédente. En effaçant une ligne, j'ai un problème de référence qui se cré pour les lignes subséquentes alors je ne fais que rétablir la numérotation en recopiant la formule de la ligne au-dessus (uniquement dans ma feuille active).

Merci et salutations,

 

[Phil69970]

Re

Maligne=ActiveCell efface une seule ligne (celle de la cellule active) alors que ce que je veux c'est effacer plusieurs lignes sélectionnées par l'utilisateur.

Je n'avais pas compris que tu en effaçais plusieurs d'un coup, effectivement mon code agit uniquement sur la ligne active

Donc si j'ai compris tu souhaites que l'utilisateur puisse sélectionner X lignes et puise les supprimer dans X feuilles en même temps

@ShrekL
*Confirme moi mon code fonctionne bien pour la ligne active de la feuille active et la même ligne des autres feuilles (déclarer dans ton array)

@Phil69970

 

[ShrekL]

Re


Je n'avais pas compris que tu en effaçais plusieurs d'un coup, effectivement mon code agis uniquement sur la ligne active

Donc si j'ai compris tu souhaites que l'utilisateur puisse sélectionner X lignes et puise les supprimer dans X feuilles en même temps

@Phil69970

Exactement. :-D

 

[Phil69970]

Re

@ShrekL

Je te propose ceci :

Sub suppr()

Pages = Array(Feuil3.Name, Feuil5.Name, Feuil8.Name, Feuil10.Name)      '   Définir les feuilles par les no de feuil
rapp = Array(Feuil5.Name, Feuil8.Name, Feuil10.Name)                             '   Définir les rapports par les no de feuil

For Each x In Pages
    Sheets(x).Unprotect                                                 '   Enlever la protection des feuilles
Next x


Dim MaZone&, DebZone&, FinZone&

MaZone = Selection.Rows.Count       '   Nbre de ligne sélectionné
DebZone = ActiveCell.Row            '   Début de la selection
FinZone = DebZone + MaZone          '   Fin de la selection ==> Debut de la sélection + Nbre de ligne sélectionné
'MaLigne = ActiveCell.Row           '   Code pour supprimer SEULEMENT la ligne Active

For Each y In rapp
    Sheets(y).Rows(DebZone & ":" & FinZone).EntireRow.Delete            '   Suppression de la ligne dans toutes les feuilles de l'array rapp
    'Sheets(y).Rows(MaLigne).EntireRow.Delete                           '   Suppression QUE de la ligne Active dans toutes les feuilles de l'array rapp
Next y

MsgBox MaZone & " lignes ont été supprimées", vbInformation, "Suppression effectuée"

Cells(ActiveCell.Row, 1).Select
ActiveCell.Offset(-2, 0).Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False

For Each x In Pages
    Sheets(x).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
        AllowFormattingColumns:=True, AllowFormattingRows:=True         '   Remets la protection des feuilles
Next x
End Sub

*Merci de ton retour

@Phil69970

 

[ShrekL]

Merveilleux Phil69970!!! Ça fonctionne à merveille et j'ai naturellement enlevé un peu de superflu.

Voici mon code final pour information

Sub Effacer_ligne()
'
' Effacer les lignes sélectionnées

'   Définir les feuilles par les no de feuil
    Pages = Array(Feuil3.Name, Feuil5.Name, Feuil8.Name, Feuil10.Name)
    
'   Définir la variable x
    For Each x In Pages
    
'   Enlever la protection des feuilles
        Sheets(x).Unprotect
        Next x

'   Définition des variables
    Dim MaZone&, DebZone&, FinZone&

    MaZone = Selection.Rows.Count       '   Nbre de ligne sélectionné
    DebZone = ActiveCell.Row            '   Début de la selection
    FinZone = DebZone + MaZone          '   Fin de la selection ==> Debut de la sélection + Nbre de ligne sélectionné


    For Each x In Pages
    Sheets(x).Rows(DebZone & ":" & FinZone).EntireRow.Delete            '   Suppression de la ligne dans toutes les feuilles de l'array rapp

    Next x
    
    Cells(ActiveCell.Row, 1).Select
    ActiveCell.Offset(-2, 0).Copy
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    For Each x In Pages
    Sheets(x).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True
    
    Next x

End Sub