Dim i As Long
For i = 2 To Documents(1).Paragraphs.Count
stoka = ActiveDocument.Paragraphs(i).Range.Text

длина = Len(stoka)
If длина > 30 Then
p1 = InStr(stoka, " ")
строка1 = Mid(stoka, p1 + 1)
имя = Left(stoka, p1)
p2 = InStr(строка1, " ")
строка2 = Mid(строка1, p2 + 1)
stoka = имя & ":  " & строка2
stoka = Replace(stoka, "_", "")
stoka = Replace(stoka, "_.", "")
stoka = Replace(stoka, "youtube", "youtube_")
ActiveDocument.Paragraphs(i).Range.Text = stoka
End If

Dim Nrav As String
Nrav = InStr(stoka, "Нравится")
If Nrav <> 0 Then
ActiveDocument.Paragraphs(i).Range = " " & vbCrLf
If ActiveDocument.Paragraphs(i).Range = ActiveDocument.Paragraphs(i - 1).Range Then
ActiveDocument.Paragraphs(i).Range.Delete
i = i - 1
End If
End If

Next
End Sub