Option Explicit

 'локальный адрес целевой клетки на листе 
Private tAddress As String
 'целевой валидатор 
Private tVal As Validation

 'валидатор по которому будем восстанавливать целевой в случае разрушения (образцовый валидатор) 
Private testRV As Validation

 'последнее допустимое значение целевой клетки 
Private prevGoodValue As Variant


Private Sub Worksheet_Activate()
 'эта процедура сработает при выборе листа, на котором расположена целевая клетка 
 'Может быть это надо вместе с переменными 
 'и методами доступа вынести на уровень рабочей книги, например, на открытие книги. 
 ' 

 'так можно было бы переопределять клавиатуру, но это не спасает от мыши 
   'Application.OnKey "+{INSERT}", "MyKeyProc" 
   'Application.OnKey "^v", "MyKeyProc2" 
  
    With Range("PROBLEM")
      'целевой валидатор 
      Set tVal = .Validation
        'адрес 
       tAddress = Range("PROBLEM").Address
        'образцовый валидатор 
       Set testRV = Range("TESTRANGE").Validation
       'текущее значение целевой клетки, в предположении, что оно "допустимое" 
       prevGoodValue = .Value
     End With
  
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
 'здесь оказываемся при любом изменении, которое прорвалось сквозь  
 'валидацию (включая её разрушение)  

 If Target.Address = tAddress Then
    Dim strMess As String
    Dim ErrFlag As Boolean
    
    On Error Resume Next
     'пытаемся обратиться к свойству, которое должно дать ошибку 
     'в случае порчи валидатора. 
     'Возможно умнее обращаться к Formula1 
     'т.к. ErrorMessage, вообще говоря, необязан быть определен. 
    strMess = tVal.ErrorMessage
    
    If Err.Number <>  0  Then
     ' сюда попадаем, когда валидатор разрушен 
      'восстанавливаем валидатор по образцу 
      With tVal
        .Delete
        .Add testRV.Type, testRV.AlertStyle, testRV.Operator, testRV.Formula1, testRV.Formula2
        .ErrorMessage = testRV.ErrorMessage
        .InCellDropdown = testRV.InCellDropdown
        .InputMessage = testRV.InputMessage
        .InputTitle = testRV.InputTitle
        .ShowInput = .ShowInput
        .ShowError = .ShowError
        .ErrorTitle = .ErrorTitle
        .IgnoreBlank = .IgnoreBlank
      End With
      Err.Clear
       'Установим флаг "отмены изменений" 
      ErrFlag = True
    
    Else
       'валидатор цел, но, возможно, не сработал 
       'Установим флаг "отмены изменений" 
       ErrFlag = Not tVal.Value
    End If
    
     'отменим изменения или запомним последнее пригодное к использованию значение 
     ' 
    If ErrFlag Then
      Target.Value = prevGoodValue
      MsgBox "Отмена вставки значения: " & testRV.ErrorMessage
    Else
      prevGoodValue = Target.Value
    End If
  End If
End Sub