Microsoft 365 Suppression du contenu de plusieurs cellules et remonter les cellules suivantes

[Alain 79]

Bonjour,
J'ai sur une feuille excel des informations saisies colonne A, B, C, D et la saisie peut s'effectuer sur les lignes 2 à 40.
Lorsque des informations sont saisies dans la colonne A un symbole (lettre Q police Wingdings2) apparait colonne E (ligne 2 à 40) par le biais d'une formule (=Si(A<>"";"G";"")
Je souhaiterai que lorsque je clique sur le symbole colonne E, le contenu de la ligne colonne A à D s'efface et que le contenu des lignes suivantes remonte sans modifier la formule contenue dans la colonne E.
Bien entendu le contenu des cellules A2 à D40 peut être effacé pour permettre une nouvelle saisie à l'aide d'une macro qui ne me pose pas de problème.
Le fichier ci-joint est simplifié pour juste permettre de comprendre mon problème.
Par avance, je vous remercie

 

[sylvanu]

Bonjour Alain,
Essayez avec :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [E:E]) Is Nothing Then
        If Target = "Q" Then Rows(Target.Row).Delete
    End If
Fin:
End Sub

 

[Alain 79]

Bonjour Sylvanu
Merci pour la rapidité de la réponse, j'essaie de l'adapter à mon fichier car ça semble correspondre à la solution recherchée.

 

[Alain 79]

Hélas non, ça ne fonctionne pas pour mon fichier car ta macro supprime la ligne entière non pas seulement le contenu des cellules des colonnes A à D et réduit la plage contenant le symbole colonne E qui doit toujours rester ligne 2 à 40.
Mon vrai fichier contient des informations dans la feuille concernée et la suppression des lignes entières supprime ces informations et contenu.

 

[sylvanu]

ça ne fonctionne pas pour mon fichier car ta macro supprime la ligne entière non pas seulement le contenu des cellules des colonnes A à D et réduit la plage contenant le symbole colonne E qui doit toujours rester ligne 2 à 40.

Sorry, ce point n'était pas très clair.
Une V2 :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [E:E]) Is Nothing And Target = "Q" Then
        L = Target.Row: DL = Range("A40").End(xlUp).Row
        Application.EnableEvents = False
        Range("A" & L & ":D39") = Range("A" & L + 1 & ":D40").Value
        Range("A40:D40").ClearContents
    End If
Fin:
Application.EnableEvents = True
[A1].Select
End Sub

 

[job75]

Bonjour Alain79, sylvanu,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Column <> 5 Or ActiveCell <> "Q" Then Exit Sub
Cells(ActiveCell.Row, 1).Select
If ActiveCell.Row < 40 Then Range(ActiveCell, "D39") = Range(ActiveCell(2), "D40").Value
Range("A40:D40") = ""
End Sub

A+

 

[Alain 79]

Sorry, ce point n'était pas très clair.
Une V2 :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [E:E]) Is Nothing And Target = "Q" Then
        L = Target.Row: DL = Range("A40").End(xlUp).Row
        Application.EnableEvents = False
        Range("A" & L & ":D39") = Range("A" & L + 1 & ":D40").Value
        Range("A40:D40").ClearContents
    End If
Fin:
Application.EnableEvents = True
[A1].Select
End Sub

Ta macro effectue bien la suppression souhaitée mais toutes les cellules sont figées.

 

[sylvanu]

Oups! un [A1].Select mal placé.

 

[Alain 79]

Bonjour Alain79, sylvanu,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Column <> 5 Or ActiveCell <> "Q" Then Exit Sub
Cells(ActiveCell.Row, 1).Select
If ActiveCell.Row < 40 Then Range(ActiveCell, "D39") = Range(ActiveCell(2), "D40").Value
Range("A40:D40") = ""
End Sub

A+

Bonjour Job75,
Ton code marche bien sur le classeur d'essai, il ne me reste plus qu'à voir si cela fonctionne avec mon fichier après l'avoir adapté aux colonnes et lignes réelles. Je pense que ça va marcher.

 

[Alain 79]

Oups! un [A1].Select mal placé.

Ah là ça me semble mieux correspondre à ce que je souhaite, je vais l'intégrer dans mon fichier pour voir le résultat. Merci

 

[Alain 79]

Ah là ça me semble mieux correspondre à ce que je souhaite, je vais l'intégrer dans mon fichier pour voir le résultat. Merci

Je viens d'adapter la macro à mon fichier et seul problème rencontré au lancement de la macro : "Variable non définie". Alors j'ai complété avec : Dim L As String, DL As String, et là ça fonctionne. Je ne comprends pas pourquoi dans le classeur d'essai cela fonctionne sans déclarer de variable.

 

[sylvanu]

Je ne comprends pas pourquoi dans le classeur d'essai cela fonctionne sans déclarer de variable.

En VBA la déclaration de variables est facultative. Elle devient obligatoire s'il y a un "Option explicit".
Généralement je les déclare quand je fais un fichier complet, lorsque c'est juste un morceau de code, la déclaration, si désirée est à rajouter.

 

[Alain 79]

Ah très bien, merci pour la réponse qui m'a permis d'en apprendre un peu plus. Sur mon fichier, avec la commande : "Sub Worksheet_Change" je rencontrais quelques difficultés alors j'ai opté pour : "Worksheet_BeforeDoubleClick" et là tout fonctionne.