Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow&, lClmn&
Dim iRng As Range
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
With Me
  lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
  lRow = IIf(lRow < 4, 4, lRow)
  lColmn = .Cells(2, .Columns.Count).End(xlToLeft).Column
  lColmn = IIf(lClmn < 6, 6, lClmn)
  Set iRng = .Range(.Cells(4, 6), .Cells(lRow, lClmn))
  If Not Intersect(Target, iRng) Is Nothing And Target.Count = 1 Then
    If Not Target.MergeCells Then
      If Not IsEmpty(Target) Then
        .Cells(Target.Row, 5) = Format(Date, "dd.mm.yyyy")
      End If
    End If
  End If
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Public SheetsList$

Sub ListSheetsValidation()
Dim iSh As Worksheet
Dim dic As Object
Dim iTmp
On Error Resume Next
Set dic = CreateObject("Scripting.Dictionary")
For Each iSh In ThisWorkbook.Worksheets
  If iSh.Name <> "Главный" Then
    iTmp = dic(iSh.Name)
    iSh.Visible = xlSheetHidden
  End If
Next
If dic.Count > 0 Then
  SheetsList = Join(dic.Keys, ",")
  SheetsList = "Скрыть все, Показать все," & SheetsList
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Target, Range("C16")) Is Nothing And Target.Count = 1 Then
  Dim iSh As Worksheet
  For Each iSh In ThisWorkbook.Worksheets
    Select Case Target
      Case Is = "Показать все"
        iSh.Visible = xlSheetVisible
      Case Else
        If iSh.Name <> Me.Name And iSh.Name <> Target.Value Then
          iSh.Visible = xlSheetHidden
        Else
          iSh.Visible = xlSheetVisible
          iSh.Activate
        End If
    End Select
  Next
End If
Application.ScreenUpdating = True
End Sub

Private Sub Workbook_Open()
Application.ScreenUpdating = False
On Error Resume Next
Call ListSheetsValidation
With ThisWorkbook.Worksheets("Главный").Range("C16").Validation
  .Delete
  If SheetsList <> "" Then
    .Add Type:=xlValidateList, Formula1:=SheetsList
  End If
End With
Application.ScreenUpdating = True
End Sub