Private Sub Worksheet_Change(ByVal Target As Range)
Dim Pwd$
Pwd = "test"
On Error Resume Next
Application.ScreenUpdating = False
If Not Intersect(Target, Range("d6:j33")) Is Nothing Then
Target = WorksheetFunction.Proper(Target)
Worksheets(1).Unprotect Pwd
Worksheets(9).Unprotect Pwd
Worksheets(1).Range("G24") = Now
Worksheets(9).Range("AB3") = Now
Worksheets(1).Protect Pwd
Worksheets(9).Protect Pwd
ElseIf Not Intersect(Target, Range("k6:q33")) Is Nothing Then
Target = WorksheetFunction.Proper(Target)
Worksheets(2).Unprotect Pwd
Worksheets(9).Unprotect Pwd
Worksheets(2).Range("G24") = Now
Worksheets(9).Range("AB3") = Now
Worksheets(2).Protect Pwd
Worksheets(9).Protect Pwd
ElseIf Not Intersect(Target, Range("r6:x33")) Is Nothing Then
Target = WorksheetFunction.Proper(Target)
Worksheets(3).Unprotect Pwd
Worksheets(9).Unprotect Pwd
Worksheets(3).Range("G24") = Now
Worksheets(9).Range("AB3") = Now
Worksheets(3).Protect Pwd
Worksheets(9).Protect Pwd
ElseIf Not Intersect(Target, Range("y6:ae33")) Is Nothing Then
Target = WorksheetFunction.Proper(Target)
Worksheets(4).Unprotect Pwd
Worksheets(9).Unprotect Pwd
Worksheets(4).Range("G24") = Now
Worksheets(9).Range("AB3") = Now
Worksheets(4).Protect Pwd
Worksheets(9).Protect Pwd
End If
End Sub