Sub BlokYa()
    Dim d_ As Range
    c1_ = Cells(4, Columns.Count).End(1).Column
    c0_ = 4
    r0_ = 4
    r1_ = Cells(Rows.Count, c0_ - 1).End(3).Row
    For Each d_ In Cells(r0_, c0_).Resize(1, c1_ - c0_ + 1)
        If IsDate(d_) Then
            Cells(r0_ - 1, d_.Column).Resize(r1_ - r0_ + 2, 6).Locked = DateAdd("m", 1, d_) < Date
        End If
    Next d_
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    c1_ = Cells(4, Columns.Count).End(1).Column
    c0_ = 4
    r0_ = 4
    If Not Intersect(Target, Cells(r0_, c0_).Resize(1, c1_ - c0_ + 1)) Is Nothing Then
        BlokYa
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Sheets(ActiveSheet.Name & "_dates").Cells(Target.Row, Target.Column).Value = Now
End Sub

Private Sub Workbook_Open()
Dim sH As Object, sP As Object, cC As Range, rN As Range
Dim acS As Object, acC As Range
Dim mOg As Double
    
Application.ScreenUpdating = False

    Set acS = ActiveSheet
    Set acC = ActiveCell
    mOg = Year(Now) + Month(Now)
    For Each sH In Worksheets
        If Right(sH.Name, 6) = "_dates" Then
            Set rN = Nothing
            Set sP = Sheets(Left(sH.Name, Len(sH.Name) - 6))
            For Each cC In sH.UsedRange
                If (cC.Value <> Empty) And (mOg > (Year(cC.Value) + Month(cC.Value))) Then
                    If sP.Cells(cC.Row, cC.Column).Locked = False Then
                        If rN Is Nothing Then
                            Set rN = sP.Cells(cC.Row, cC.Column).MergeArea
                        Else
                            Set rN = Union(rN, sP.Cells(cC.Row, cC.Column).MergeArea)
                        End If
                    End If
                End If
            Next cC
            If Not rN Is Nothing Then
                
                sP.Unprotect Password:="321"
                sP.Cells.Locked = False
                rN.Locked = True
                sP.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
                    AllowFormattingCells:=True, AllowFormattingColumns:=True, _
                    AllowFormattingRows:=True, AllowFiltering:=True, Password:="321"
            End If
        End If
    Next sH
    acS.Select
    acC.Select
Application.ScreenUpdating = True
End Sub