Faire apparaitre date en auto

Bonjour à tous

Je vous soumets mon challenge du jour

Donc en faite j'ai une plage de cellule A22:A1004, mon but et que des qu'on rensgne une valeur dans cette plage (j'ai mis une liste déroulante) alors la date doit apparaitre en auto dans la cellule juste à droite.

Avec beaucoup de mal j'ai écris le code ci dessous.

Premier problème : lorsque j'efface les valeurs entrée dans la colonne A, la date ne s'efface pas dans la cellule A23 et quand je l'efface manuellement elle réapparait en continue

2ème problème

je souhaite faire la même chose pour la colonne C, c'est à dire des qu'une valeur est renseigné alors la date apparait en D dans la ligne correspondante, comment faire ?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim plage As Range
Set plage = Range("A22 :A1004")
If Application.Intersect(Target, plage) Is Nothing Then Exit Sub
If Not IsEmpty(Target.Value) Then
    Target(, 2) = Date
ElseIf IsEmpty(Target.Value) Then
    Target(, 2) = ""
End If
End Sub

Bonjour,

A tester :

Private Sub Worksheet_Change(ByVal Target As Range)

    If Application.Intersect(Target, Range("A22:A1004, C22:C1004")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub

    Application.EnableEvents = False

    If Target.Value = "" Then Target.Offset(, 1).Value = "" Else Target.Offset(, 1) = Date

    Application.EnableEvents = True

End Sub

Super ça fonctionne beaucoup mieux merci

est ce que c'est possible de verouiller les cellules A22, B22 et E22:AQ22 quand A22 est renseigné

et sur le même principe C22, D22 et AR22:AV22 quand C22 est renseigné et ainsi de suite sur toute la colonne

J'ai commencé a écrire ça mais j'arrive pas à aller plus loin

If Target.Column = 1 And Target.Row >= 21 And Target.Cells.Count = 1 Then
   With Me
      .Unprotect ("mdp")
      .Range("A" & Target.Row & ":DO" & Target.Row).Locked = (Target.Value <> "")
      .Protect ("mdp")
   End With
End If
End Sub

personne ?

Bonjour,

Testes et dis moi :

Private Sub Worksheet_Change(ByVal Target As Range)

    With Target

        If Application.Intersect(Target, Range("A22:A1004, C22:C1004")) Is Nothing Then Exit Sub
        If .Count > 1 Then Exit Sub

        Application.EnableEvents = False

        If .Value = "" Then .Offset(, 1).Value = "" Else .Offset(, 1) = Date

        .EntireRow.Locked = False 'déverrouille toute la ligne

        'verrouille en fonction
        If .Column = 1 Then Union(.Offset(, 1), Range(.Offset(, 4), .Offset(, 42))).Locked = Target.Value <> "" 'si colonne A
        If .Column = 3 Then Union(.Offset(, 1), Range(.Offset(, 41), .Offset(, 45))).Locked = Target.Value <> "" 'si colonne C

        Application.EnableEvents = True

    End With

End Sub

Salut

merci pour ta réponse,

ça ne fonctionne pas

est ce que je peux joindre mon fichier pour que tu vois

peut être que c'est parceque j'ai la feuille qui est verrouillé par un mot de passe ?

merci d'avance

Coucou Theze

Après avoir passer toute l'aprem midi et toute la soirée sur les forum

J'ai trouvé mon erreur

Donc en faite les cellules était verouillées, donc via forma de cellule j'ai décoché verouillé,

et j'ai ajouter 2 lignes dans le code pour déproteger et proteger la feuille

Private Sub Worksheet_Change(ByVal Target As Range)

With Target

If Application.Intersect(Target, Range("A22:A1004, C22:C1004")) Is Nothing Then Exit Sub
If .Count > 1 Then Exit Sub

Application.EnableEvents = False

If .Value = "" Then .Offset(, 1).Value = "" Else .Offset(, 1) = Date

ActiveSheet.Unprotect

'verrouille en fonction
If .Column = 1 Then
ActiveSheet.Unprotect
Union(.Offset(, 1), Range(.Offset(, 4), .Offset(, 42))).Locked = Target.Value <> "" 'si colonne A
ActiveSheet.Protect
End If

If .Column = 3 Then
ActiveSheet.Unprotect
Union(.Offset(, 1), Range(.Offset(, 41), .Offset(, 45))).Locked = Target.Value <> "" 'si colonne C
ActiveSheet.Protect
End If

Application.EnableEvents = True

End With

End Sub

Encore merci pour ton aide

Bonjour,

L'instruction exécutée une fois suffit :

Private Sub Worksheet_Change(ByVal Target As Range)

    With Target

        If Application.Intersect(Target, Range("A22:A1004, C22:C1004")) Is Nothing Then Exit Sub
        If .Count > 1 Then Exit Sub

        Application.EnableEvents = False

        If .Value = "" Then .Offset(, 1).Value = "" Else .Offset(, 1) = Date

        Application.EnableEvents = True

        ActiveSheet.Unprotect

        'verrouille en fonction
        If .Column = 1 Then Union(.Offset(, 1), Range(.Offset(, 4), .Offset(, 42))).Locked = Target.Value <> "" 'si colonne A
        If .Column = 3 Then Union(.Offset(, 1), Range(.Offset(, 41), .Offset(, 45))).Locked = Target.Value <> "" 'si colonne C

        ActiveSheet.Protect

    End With

End Sub

Merci ça marche aussi, par contre je me suis rendu compte d'un petit problème

quand j'efface les valeurs entré dans les plages de données A22:A1004 et C22:C1004

les cellules restent verrouillés

c'est possible de dire en gros si j'efface A22:A1004 et C22:C1004, alors ce qui a été verrouillé ne l'est plus ?

Merci pour ton aide

Bonjour,

Testes ceci :

Private Sub Worksheet_Change(ByVal Target As Range)

    With Target

        If Application.Intersect(Target, Range("A22:A1004, C22:C1004")) Is Nothing Then Exit Sub
        If .Count > 1 Then Exit Sub

        Application.EnableEvents = False

        If .Value = "" Then .Offset(, 1).Value = "" Else .Offset(, 1) = Date

        Application.EnableEvents = True

        ActiveSheet.Unprotect

        'verrouille en fonction
        If .Column = 1 Then Union(.Offset(, 1), Range(.Offset(, 4), .Offset(, 42))).Locked = IIf(Target.Value <> "", True, False)
        If .Column = 3 Then Union(.Offset(, 1), Range(.Offset(, 41), .Offset(, 45))).Locked = IIf(Target.Value <> "", True, False)

        ActiveSheet.Protect

    End With

End Sub