XL 2013 Effacer plusieurs "Target" avec touche SUPPR (Worksheet_Change)

[Bitiligo]

Bonjour le forum,

J'ai un petit soucis sur l'évènement Worksheet_Change.

Pour info, j'ai un fichier dans lequel se trouve deux onglets : un onglet "CALCUL" et un onglet "BIBLIOTHEQUE". L'onglet "BIBLIOTHEQUE" fonctionne comme une base de données. Dans l'onglet "CALCUL", le but est que lorsque l'utilisateur saisi une valeur dans la colonne A (valeur correspondante à une ligne de la colonne A de l'onglet "BIBLIOTHEQUE"), la colonne B récupère automatiquement la valeur stockée dans l'onglet "BIBLIOTHEQUE" correspondante à la ligne. Toujours dans l'onglet "CALCUL", lorsque la valeur du target (donc colonne A) est vide, la valeur correspondante dans la colonne B est effacée. Jusu'ici je n'ai aucun problème.

Mon problème est le suivant : dans l'onglet "CALCUL", lorsque l'utilisateur souhaite effacer plusieurs lignes, le but est de mettre en surbrillance les cellules correspondantes à l'effacement des données souhaitées dans la colonne A et de taper sur la touche SUPPR du clavier, les target s'effacent bien mais pas les valeurs de la colonne B.

Pour résumer mon problème, en appuyant sur DEL ou SUPPR sur une seule cellule du target, l'effacement de la ligne fonctionne mais pas sur une multi-sélection de cellules pour la touche SUPPR. Comment y remédier ?

Ci-joint un fichier exemple pour que vous puissiez visualiser concrètement mon problème.

Je ne pense pas que ça soit un problème majeur, c'est juste un soucis d'effacement avec la touche SUPPR sur plusieurs target. Cependant j'ai essayé pleins de solutions et rien n'y fait .

Cordialement,

Bitiligo.

 

[chris]

Bonjour

Ta ligne

If Target.Count > 1 Then Exit Sub

quitte la procédure en cas de multi sélection...

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub
If Target.Count > 1 And Target.Cells(1, 1).Value <> "" Then Exit Sub

If Target.Cells(1, 1) = "" Then
  Target.Offset(0, 1).ClearContents
  Exit Sub
End If

For lig = 2 To Sheets("BIBLIOTHEQUE").[A1000000].End(xlUp).Row
  If Target.Value = Sheets("BIBLIOTHEQUE").Cells(lig, 1) Then
   
  ActiveSheet.Range("B" & Target.Row & ":B" & Target.Row).Value = _
  Sheets("BIBLIOTHEQUE").Range("B" & lig & ":B" & lig).Value
   
  Exit For
  End If
Next

End Sub

 

[Bitiligo]

IMPECCABLE ! Merci Chris !

(Je savais que le Target.Count > 1 empêche la multi-sélection mais lorsque je retirais ce code il y avait un bug). Bref merci beaucoup !