---

Sub PasteAndClean()
    ' 1. Вставка как неформатированный текст
    Selection.PasteSpecial DataType:=wdPasteText, Placement:=wdInLine

    ' 2. Преобразование регистра: каждое слово с заглавной
    Selection.Range.Text = StrConv(Selection.Range.Text, vbProperCase)

    ' 3. Обработка абзацев (чистка и интервалы)
    Dim para As Paragraph
    Dim i As Long

    ' Убираем конечные пробелы/табы и обнуляем SpaceAfter
    For Each para In Selection.Paragraphs
        With para.Range
            If .Characters.Count > 1 Then
                .MoveEnd Unit:=wdCharacter, Count:=-1
                Do While .Characters.Count > 0 And _
                        (.Characters.Last = " " Or .Characters.Last = vbTab)
                    .Characters.Last.Delete
                Loop
            End If
        End With
        para.SpaceAfter = 0
    Next para

    ' Удаляем пустые абзацы (ищем в обратном порядке)
    For i = Selection.Paragraphs.Count To 1 Step -1
        Set para = Selection.Paragraphs(i)
        Dim txt As String
        txt = para.Range.Text
        txt = Replace(txt, " ", "")
        txt = Replace(txt, vbTab, "")
        If Len(txt) = 1 And Asc(txt) = 13 Then ' только маркер конца абзаца
            para.Range.Delete
        End If
    Next i

    MsgBox "Готово! Имена приведены к Proper Case, лишние пробелы и пустые строки удалены.", vbInformation
End Sub