complément de code sur Worksheet_Change

[kinel]

Bonjour à tous

j'utilise le code suivant pour effacer automatiquement une série de cellules
j'aimerai compléter ce code pour que les cellules effacées soient sauvegardées dans une feuille secondaire

Merci de votre aide

Kinel




Private Sub Worksheet_Change(ByVal Target As Range)
Dim flag As Boolean


'efface les infos si le nom est effacé
If Target.Column <> 4 Or Target.Count > 1 Or (Target.Row < 3 Or Target.Row > 62) Then Exit Sub
If IsEmpty(Target) Then
Application.EnableEvents = False
If MsgBox("Confirmer la suppression?", vbYesNo + vbQuestion, "SUPPRIMER") = vbYes Then
Cells(Target.Row, 14) = Cells(Target.Row, 10)
Target.Offset(, -1).Resize(1, 7) = ""
Else
Target = Cel
End If
Application.EnableEvents = True
End If

 

[camarchepas]

Re : complément de code sur Worksheet_Change

Bonjour,

Peut être comme ceci : L'Onglet Sauve doit exister, ou modifier le code en conséquence

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim flag As Boolean
 

'efface les infos si le nom est effacé
 If Target.Column <> 4 Or Target.Count > 1 Or (Target.Row < 3 Or Target.Row > 62) Then Exit Sub
 If IsEmpty(Target) Then
   Application.EnableEvents = False
   If MsgBox("Confirmer la suppression?", vbYesNo + vbQuestion, "SUPPRIMER") = vbYes Then
     Cells(Target.Row, 14) = Cells(Target.Row, 10)
     'Copie de sauvegarde
     Target.Offset(, -1).Resize(1, 7).Copy Destination:=Sheets("Sauve").Range("a" & Sheets("Sauve").Range("a" & Rows.Count).End(xlUp).Row)
     Target.Offset(, -1).Resize(1, 7) = ""
    Else
     Target = Cel
   End If
   Application.EnableEvents = True
 End If
End Sub

 

[Si...]

Re : complément de code sur Worksheet_Change

salut

la variarble flag ne sert pas par contre Cel doit être initialisée !

Avec ce que j'imagine :

Option Explicit
Dim cel
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Column <> 4 Or Target.Count > 1 Or (Target.Row < 3 Or Target.Row > 62) Then Exit Sub
  cel = Target
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  'efface les infos si le nom est effacé
   If Target.Column <> 4 Or Target.Count > 1 Or (Target.Row < 3 Or Target.Row > 62) Then Exit Sub
  If Target <> "" Then Exit Sub
  Application.EnableEvents = False
  If MsgBox("Confirmer la suppression?", vbYesNo + vbQuestion, "SUPPRIMER") = vbYes Then
    Target(1, 11) = Target(1, 7)
    With Target(1, 0).Resize(1, 7)
      .Value = cel
      .Copy Feuil2.[A65000].End(xlUp)(2) 'à toi de définir l'endroit
      .Value = ""
    End With
  Else
    Target = cel 'cel doit être initalisée
  End If
  Application.EnableEvents = True
End Sub

 

[kinel]

Re : complément de code sur Worksheet_Change

bonjour
merci pour ces propositions

je teste la version de Si...

ça fonctionne mais la sauvegarde me copie 7 fois le contenu de la cellule 4
alors que l'idéal serait de sauvegarder les cellules 2,3,4,5,6,7,8,et 9 de la Feuil1 vers la Feuil2 en 2,3,4,5,6,7,8 et 9

merci de votre aide

Kinel