Suppression de plusieurs cellules erreur d'exécution '13'

[Christian_koffi]

Bonjour,
J'ai réalisé une macro:
cette macro permet de d'enregistrer dans les colonnes AD, AE, AF et AG la première date lorsque je met le chiffre 1 dans les colonnes O, P, Q et R.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 15 And Target.Column <> 16 And Target.Column <> 17 And Target.Column <> 18 Then Exit Sub
Target.Offset(0, 11) = IIf(Target.Value = "", "", Target.Offset(0, 15))
Target.Offset(0, 15) = IIf(Target.Value = "", "", Date)
Target.Offset(0, 15) = IIf(Target.Value <> "", Target.Offset(0, 15).Value, "")
If Target.Offset(0, 11).Value = "" And Target.Offset(0, 16).Value <> "" Then
Target.Offset(0, 15).Value = Date
End If
If Target.Offset(0, 11).Value <> "" And Target.Offset(0, 15).Value <> "" Then
Target.Offset(0, 15).Value = Target.Offset(0, 11).Value
End If
End Sub

Mes problèmes sont les suivants:
- Dans les colonnes l'une des colonnes O, P, Q et R, lorsque je sélectionne plusieurs cellule et je supprime les valeurs de ces cellules en même temps un bug survient :erreur d'exécution '13'
- Lorsque je sélectionne une cellule et que je tire vers le bas pour recopier la même valeur j'ai la même erreur et je ne voie aucun résultat dans les colonnes AD, AE, AF et AG.
Merci.
ci joint le fichier.

 

[Compte Supprimé 979]

Re : Suppression de plusieurs cellules erreur d'exécution '13'

Bonjour Christian

Voici le code corrigé

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rng As Range
  If Target.Column <> 15 And Target.Column <> 16 And Target.Column <> 17 And Target.Column <> 18 Then Exit Sub
  ' Empècher les évènements de se reproduire
  Application.EnableEvents = False
  ' Pour chaque cellule sélectionnée
  For Each Rng In Target
    Rng.Offset(0, 11) = IIf(Rng.Value = "", "", Rng.Offset(0, 15))
    Rng.Offset(0, 15) = IIf(Rng.Value = "", "", Date)
    Rng.Offset(0, 15) = IIf(Rng.Value <> "", Rng.Offset(0, 15).Value, "")
    If Rng.Offset(0, 11).Value = "" And Rng.Offset(0, 16).Value <> "" Then
      Rng.Offset(0, 15).Value = Date
    End If
    If Rng.Offset(0, 11).Value <> "" And Rng.Offset(0, 15).Value <> "" Then
      Rng.Offset(0, 15).Value = Rng.Offset(0, 11).Value
    End If
  Next Rng
  ' Ré-activer les évènements
  Application.EnableEvents = True
End Sub

A+

 

[Christian_koffi]

Re : Suppression de plusieurs cellules erreur d'exécution '13'

Merci pour ce code, mais j'ai un autre problème losque jexécute ce code en mettant une valeur dans une des cellules des colonnes. O, P, Q, R, je ne voie aucune date s'afficher. L'objectif de ce code est denregistrer la date de première saisi dans les cellules parallèles des colonnes AD, AE, AF, AG. Quand je met une valeur dans lune des cellules des colonnes O, P, Q, R, je voudrais que la date senregitre dans les cellules des autres colonnes. Et même si un autre jour je modifie la valeur que la premier date reste figée et ne doit recuperer la date de ce jour. Je veux figer la date de premiere saisi dune valeur meme si un autre jour je viens à modifier cette valeur.
Merci.

 

[camarchepas]

Re : Suppression de plusieurs cellules erreur d'exécution '13'

Bonjour Bruno, Christian

Bon , je crois qu'il faut revoir les équations d'effacement et d'écriture

je vois que l'on tiens compte aussi de la cellule AH , par contre dans cette portion de code on ne la charge pas ?

Peux-tu nous faire sur 3 ou 4 lignes une grille avec l'attendu dans les colonnes AD, AE,AF,AG en fonction des colonnes O,P,Q,R.

Je vois également que si la cellule changée est remise à zéro , alors tu perds la date initiale , c'est aussi à préciser.

Pour ce qui est du rajout du controle des événementiels , proposé par Bruno , c'est indispensable effectivement , sinon l'on entre dans une boucle infernale

 

[Christian_koffi]

Re : Suppression de plusieurs cellules erreur d'exécution '13'

Bonjour Bruno, camarchepas
Je voudrais que lorsque je mets un nombre quelconque dans l’une des cellules de la colonne O (avec sélection multiple), avoir dans la cellule AD la date de saisi de ce nombre et cette date doit rester inchangé s’il viendrait à modifier ce nombre un autre jour.
De même si je mets un nombre dans les cellules P, Q, R, avoir le même résultat (enregistrer la date de saisi dans les cellules des colonnes AE, AF, AG et cette date doit rester inchangée s’il viendrait à modifier ce nombre un autre jour).
Je ne sais pas comment m’y prendre pour le faire, le premier code que j’avais fait marche mais il n permet pas la sélection multiple le code que Bruno m'a proposé permet la sélection multiple mais aucune date ne s’affiche dans les cellules des colonnes voulues.
N’y a-t-il pas une solution pour résoudre mon problème car je ne sais pas comment m'y prendre pour y arriver .
Merci

 

[camarchepas]

Re : Suppression de plusieurs cellules erreur d'exécution '13'

Essayes comme cela et dis moi

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zone As Range
Application.EnableEvents = False

If Target.Column < 15 Or Target.Column > 18 Then Exit Sub
  
  For Each Zone In Target
   Zone.Offset(0, 11) = IIf(Zone = "", "", Date)
  Next

Application.EnableEvents = True
End Sub

 

[Christian_koffi]

Re : Suppression de plusieurs cellules erreur d'exécution '13'

Merci à vous,
Le code de bruno marche, javais un problème avec mon fichier excel, jai mis de l'ordre dans mon fichier et ça marche. Merci beaucoup à vous.
Merci