Поиск слов и сохранение их в отдельном документе

Валерий спрашивает:

Валерий, вот пример макроса для ваших целей, подсказанный Александром Витером.

Sub startWordsChar2()
'Поиск слов, начинающихся с определенной буквы и перенос их в
'отсортированный по алфавиту список в новый документ
Dim bukva As String
Dim newDoc As Document
Dim actDoc As Document
Dim oPar As Paragraph
Dim rng As Range
Set actDoc = ActiveDocument
Set rng = actDoc.Range
Do
  bukva = InputBox("Введите начальную букву слова в поле:", "Поиск слов")
  If StrPtr(bukva) = 0 Then
     Exit Sub
  ElseIf Len(bukva) = 0 Then
     MsgBox "Введите пожалуйста начальную букву " & vbCr & "или нажмите кнопку 'Cancel"
  End If
Loop Until Len(bukva) <> 0
Application.ScreenUpdating = False
Set newDoc = Documents.Add
'Ищем слово, начинающееся с указанной буквы в любом регистре
With actDoc.Range.Find
  .Text = "<[" & StrConv(bukva & bukva, vbProperCase) & "][А-Яа-яЁё]@>"
  .MatchWildcards = True
  While .Execute
    Application.StatusBar = "Добавляем " & bukva
    newDoc.Range.InsertAfter Trim(.Parent.Text)
    newDoc.Range.InsertParagraphAfter
  Wend
End With
'Сортируем содержимое нового документа
newDoc.Range.Sort , "Paragraphs", wdSortFieldAlphanumeric, wdSortOrderAscending
'Удаляем первый пустой абзац
newDoc.Paragraphs(1).Range.Delete
'Поскольку в каждом абзаце находится по одному слову, то нужно только перебирать абзацы и удалять _
все слова, которые содержатся в текущем
For Each oPar In newDoc.Paragraphs
  If oPar.Range.End <> newDoc.Range.End Then
    With newDoc.Range(oPar.Range.End, newDoc.Range.End).Find
      .Text = oPar.Range.Text
      .Replacement.Text = ""
      .Execute Replace:=wdReplaceAll
    End With
  End If
Next
Application.ScreenUpdating = True
End Sub

Если вы не знаете, как подключить к документу и применить эти макросы, изучите следующие заметки с сайта:

Создание макроса из готового кода

Автоматическая запись макроса