Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim cellText As String, cellDate As Date
    Dim datArray, dd, mm, yy
    
    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Target, Range("B13:C35")) Is Nothing Then Exit Sub
    If IsEmpty(Target) Then Exit Sub
       
    dd = Day(Now): mm = Month(Now): yy = Year(Now) 'инициализация частей - текущей датой
    
    'в качестве разделителя компонентов даты можно использовать
    'любой удобный разделитель с цифровой клавиатуры: * + , (/ или - нельзя)
    'особенно удобен "плюс" - он большой :)
    'разделители даже можно смешивать в одном вводе
    cellText = Replace(Replace(Replace(Target.Value2, "+", "."), "*", "."), ",", ".")
    datArray = Split(cellText, ".")
    
    dd = datArray(0)
    If UBound(datArray) > 0 Then mm = datArray(1)
    If UBound(datArray) > 1 Then yy = datArray(2)
    
    Application.EnableEvents = False
    On Error Resume Next
    
    cellDate = CDate(dd & "." & mm & "." & yy)
    If Err Then
        Target.Value = "ОШИБКА: " & Target.Value2
        Err.Clear
    Else
        Target.Value = cellDate
    End If
    
    Application.EnableEvents = True
End Sub