re
voici les 2 codes à mettre dans la feuille
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo noErr
If Not Application.Intersect(Target, Range("A4:A5000")) Is Nothing Then
Target.Offset(0, 1).Value = Now
If Target.Value = "" Then Target.Offset(0, 1).Value = ""
End If
le deuxieme
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A5:A578")) Is Nothing Then: Exit Sub
apparenter
End Sub
ca c dans le module1
Sub apparenter()
Dim cptr As Byte
Dim papier As Variant
Dim info As Variant
papier = Array(1, 5, 6, 7, 8, 10, 21) 'mettre tes numéros "papiers"
info = Array(3, 4, 9, 11, 12, 13, 14, 15, 16, 17, 18, 19) 'mettre tes numéros "informatique"
If ActiveCell = "" Then Exit Sub
If ActiveCell = 2 Or ActiveCell = 19 Then ' tes nombres interdits
MsgBox "ces N° d'APP n'existent pas"
Exit Sub
End If
cptr = 1
Do While cptr <= 7 ' nombre d'eléments du tableau "papiers"
If ActiveCell = papier(cptr) Then
MsgBox "cet APP n'est pas sur labguard vérifier, valider et conserver la courbe papier"
Exit Sub
End If
cptr = cptr + 1
Loop
cptr = 1
Do While cptr <= 12
If ActiveCell = info(cptr) Then
MsgBox "cet APP est connecté sur le labguard mettre la courbe au format informatique"
Exit Sub
End If
cptr = cptr + 1
Loop
MsgBox " valeurs non classée"
End Sub
merci