Private Sub Worksheet_Change(ByVal Target As Range)
    With Application: .ScreenUpdating = False: .EnableEvents = False: End With
    Dim lr&, lrE&
    lr = Cells(Rows.Count, "d").End(xlUp).Row
    If Not Intersect(Target, Range("d7:e" & lr)) Is Nothing Then
        With ActiveSheet
            'сортируем по датам
            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=Range("d7:d" & lr), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With .Sort
                .SetRange Range("A7:E" & lr)
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            'сортируем по статуса
            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=Range("e7:e" & lr), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With .Sort
                .SetRange Range("A7:E" & lr)
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            'перемещаем Выполнено вниз
            lrE = Cells(Rows.Count, "e").End(xlUp).Row
            If lrE > 6 Then
                Range("a7:e" & lrE).Cut
                Range("a" & lr + 1).Insert Shift:=xlDown
            End If
        End With
    End If
    With Application: .ScreenUpdating = True: .EnableEvents = True: End With
End Sub