Macro évenementielle lors d'un effacement de cellule dans une colonne

[Gudo]

Bonjour à tous

J'aurai besoin d'une macro qui à intervienne à chaque fois que j'efface une cellule dans la colonne A

Je joins un exemple
Dans ce fichier, je voudrai que si j'efface une date rentrée manuellement par exemple en A4
Alors automatiquement la formule située en K3 soit recopiée dans cette cellule.

Je suis bien arrivé à faire une macro événementielle qui copie cette formule dès que je clique sur une cellule de cette colonne, mais pas lors de son effacement.

Merci d'avance pour une aide

 

[Caillou]

Re : Macro évenementielle lors d'un effacement de cellule dans une colonne

Bonjour,

Sauf erreur de ma part, ton fichier ne comporte aucun macro !!

Caillou

 

[Gudo]

Re : Macro évenementielle lors d'un effacement de cellule dans une colonne

Bonjour

Non puisque je n'arrive pas à la faire
C'est pour cela que j'ai lancé cette discussion

A+

 

[job75]

Re : Macro évenementielle lors d'un effacement de cellule dans une colonne

Bonjour Gudo, Caillou,

D'abord la formule en K3 nécessite à mon avis d'être améliorée comme ceci :

=SI(SUPPRESPACE(O3)<>"";K2;"")

Ensuite placez cette macro dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, Range("A2:A" & Rows.Count))
If r Is Nothing Then Exit Sub
Application.EnableEvents = False
If r.Count > 1000 Then
  MsgBox "Trop de cellules modifiées !", 48
  Application.Undo
Else
  For Each r In r
    If IsEmpty(r) Then r = [K3].FormulaR1C1
  Next
End If
Application.EnableEvents = True
End Sub

A+

 

[job75]

Re : Macro évenementielle lors d'un effacement de cellule dans une colonne

Re,

On peut vouloir limiter les modifications au UsedRange :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, Range("A2:A" & Rows.Count), Me.UsedRange)
If r Is Nothing Then Exit Sub
For Each r In r
  If IsEmpty(r) Then r = [K3].FormulaR1C1
Next
End Sub

En dessous de la ligne de la Dernière cellule la formule n'est pas entrée.

A+

 

[job75]

Re : Macro évenementielle lors d'un effacement de cellule dans une colonne

Re,

Une autre solution avec SpecialCells :

Private Sub Worksheet_Change(ByVal Target As Range)
If IsEmpty([A1]) Then [A1].Select: MsgBox "Entrez une date en A1...": Exit Sub
On Error Resume Next 'si aucune cellule vide
[A:A].SpecialCells(xlCellTypeBlanks) = [K3].FormulaR1C1
End Sub

Toutes les cellules vides du UsedRange en colonne A sont traitées à chaque modification.

Cela me paraît être une bien meilleure solution.

A+

 

[Gudo]

Re : Macro évenementielle lors d'un effacement de cellule dans une colonne

Bonsoir Job75

Merci tout d'abord pour ton aide

D'abord la formule en K3 nécessite à mon avis d'être améliorée comme ceci

Je suppose qu'il y a une raison pour cela, mais je ne la saisie pas ?


Je viens d'essayer les 3 macros
Mais chaque fois que j’efface le contenue de la celluleA4 comme je la donnais en exemple dans ma demande
(Ou toute cellule de cette colonne), il ne se passe rien.
La cellule K3 ne se recopie en lieu et place de la date effacée

Peut-être que je n'ai pas compris quelque chose
Ou est-ce moi qui est mal énoncé ma demande de macro ?

A+

 

[job75]

Re : Macro évenementielle lors d'un effacement de cellule dans une colonne

Re,

Quand on efface A4 la formule en K3 est entrée en A4.

La formule indique que la cellule prend la valeur de A3 qui contient un texte vide.

Effacez donc plutôt A2 ou A5...

A+

 

[Gudo]

Re : Macro évenementielle lors d'un effacement de cellule dans une colonne

Bonjour Job75

Oui pardon, les 3 solutions fonctionnent très bien
et aussi bien l'une que l'autre

Je vais utiliser la 3ème
Je ne vois pas de différence dans le traitement ?
La 3ème est la plus concis
et comme tu la conseille en priorité

Merci beaucoup pour ton aide

A+