Microsoft 365 Inscrire automatiquement la date du jour et bloquer les cellules

[sebastien176]

Bonjour à tous,

Dans le fichier ci-joint, j'aimerais pourvoir mettre :
1 - la date du jour dans la colonne J quand je renseigne la colonne H
2 - Pareil pour la colonne N quand je renseigne la colonne L

J'ai déjà ce code sur la feuille "cariste" mais n'arrive pas à trouver le moyen de faire la même chose pour les colonne L et N:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 8 Then Exit Sub
If Target.Row = 1 Then Exit Sub
Target.Offset(0, 2) = Date
Target.Offset(0, 2).Value = Target.Offset(0, 2).Value
Application.ScreenUpdating = False
ActiveSheet.Unprotect
If Not Intersect(Target, Columns("h")) Is Nothing Then
On Error Resume Next
For w = 1 To Range("h" & Rows.Count).End(xlUp).Row
If Range("h" & w) = "" Then
Range("h" & w).Locked = False
Range("j" & w).Locked = False
Else
Range("h" & w).Locked = True
Range("j" & w).Locked = True
End If
Next
End If
ActiveSheet.Protect
End Sub

Je vous remercie par avance de votre aide

Seb

 

[job75]

Bonjour sebastien176,

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, Union([H:H], [L:L]), UsedRange)
If r Is Nothing Then Exit Sub
For Each r In r
    If IsNumeric(CStr(r)) Then r(1, 3) = Date
Next
End Sub

Je ne m'occupe pas de la protection éventuelle.

A+

 

[sebastien176]

Bonjour sebastien176,

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, Union([H:H], [L:L]), UsedRange)
If r Is Nothing Then Exit Sub
For Each r In r
    If IsNumeric(CStr(r)) Then r(1, 3) = Date
Next
End Sub

Je ne m'occupe pas de la protection éventuelle.

A+

Bonjour Job75,

Je te remercie pour ton retour sur ma demande

je viens de vérifier ton code

Il marche bien mais quelques éléments me manque :

- Sur la dernière ligne de chaque mois (ligne rouge) je dois remplir en texte par la liste déroulante des colonnes H et L . Du coup il n'y à pas de report de date dans les colonnes J et N pour ces lignes.

As-tu une solutions à ces questions ?

merci d'avance

Bonne journée

Seb

 

[job75]

Bonjour sebastien176, le forum,

Le plus simple est de compléter la macro comme ceci :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, Union([H:H], [L:L]), UsedRange)
If r Is Nothing Then Exit Sub
For Each r In r
    If IsNumeric(CStr(r)) Or CStr(r) <> "" And r.Interior.Color = vbRed Then r(1, 3) = Date
Next
End Sub

A+

 

[sebastien176]

Bonjour sebastien176, le forum,

Le plus simple est de compléter la macro comme ceci :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, Union([H:H], [L:L]), UsedRange)
If r Is Nothing Then Exit Sub
For Each r In r
    If IsNumeric(CStr(r)) Or CStr(r) <> "" And r.Interior.Color = vbRed Then r(1, 3) = Date
Next
End Sub

A+

Super,

Merci encore pour ton aide Job75
Cela marche très bien

Bonne journée

Seb