---

Dim PreviousValue As String

' Шаг 1: Запоминаем текущее значение ячейки при её выделении
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count = 1 Then
        PreviousValue = Target.Value
    End If
End Sub

' Шаг 2: Формируем нумерованный список при выборе из списка
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Lines() As String
    Dim NextIndex As Long
    Dim NewSelection As String
    
    ' Укажите ваш диапазон ячеек со списком (например, "A1:A100" или "B2:B50")
    If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
        If Target.Cells.Count > 1 Then Exit Sub
        
        ' Если ячейку очистили (Delete), сбрасываем всё
        If Target.Value = "" Then
            PreviousValue = ""
            Exit Sub
        End If
        
        On Error GoTo CleanExit
        Application.EnableEvents = False
        
        NewSelection = Target.Value
        
        ' Если ячейка была пустой — создаем пункт 1.
        If PreviousValue = "" Then
            Target.Value = "1. " & NewSelection
        Else
            ' Подсчитываем текущее количество строк для следующего номера
            Lines = Split(PreviousValue, vbLf)
            NextIndex = UBound(Lines) + 2
            
            ' Добавляем новое значение с новой строки (vbLf = Enter)
            Target.Value = PreviousValue & vbLf & NextIndex & ". " & NewSelection
        End If
        
        ' Обновляем сохраненное значение для следующего выбора
        PreviousValue = Target.Value

CleanExit:
        Application.EnableEvents = True
    End If
End Sub