Private Sub Worksheet_Change(ByVal Target As Range)

Dim lReply As Long, i As Integer
Dim counter As Integer, MyName As String, NameRange As String

If Target.Cells.count > 1 Then Exit Sub
If Target.Address = "$D$2" Then
If IsEmpty(Target) Then Exit Sub
counter = Len(Target)
MyName = Left(Target, counter)
For i = 1 To Range("People").count
NameRange = Left(Range("People").Cells(i), counter)
If LCase(NameRange) = LCase(MyName) Then
Application.EnableEvents = False
Range("D2") = Range("People").Cells(i)
Application.EnableEvents = True
Exit For
End If
Next
If WorksheetFunction.CountIf(Range("People"), Target) = 0 Then
lReply = MsgBox("Добавить введенное имя " & _
Target & " в выпадающий список?", vbYesNo + vbQuestion)
If lReply = vbYes Then
Range("People").Cells(Range("People").Rows.count + 1, 1) = Target
Range("People").Sort Key1:=Range("A1"), _
Order1:=xlAscending, Header:=xlNo
Else
Target = ""
End If
End If
End If
End Sub