---

Sub ParseTextToCells()
    Dim wd As Object, doc As Object
    Dim sh As Worksheet
    Dim path As String, f As String
    Dim r As Long, i As Long
    Dim paragraphs As Object
    Dim para As Object
    
    ' ===== ВАШ ПУТЬ =====
    path = "C:\МоиДокументы\"  ' ИЗМЕНИТЕ
    
    Set sh = ThisWorkbook.Sheets(1)
    sh.Cells.Clear
    r = 2
    
    Set wd = CreateObject("Word.Application")
    wd.Visible = False
    
    f = Dir(path & "*.doc*")
    
    Do While f <> "" And r <= 51
        Set doc = wd.Documents.Open(path & f)
        
        ' ===== ЗАПИСЫВАЕМ ИМЯ ФАЙЛА =====
        sh.Cells(r, 1) = f
        
        ' ===== РАЗБИВАЕМ ТЕКСТ ПО АБЗАЦАМ =====
        Dim textParts() As String
        textParts = Split(doc.Range.Text, vbCr)  ' Разбиваем по переносам строк
        
        ' ===== ЗАПИСЫВАЕМ КАЖДЫЙ АБЗАЦ В ОТДЕЛЬНУЮ ЯЧЕЙКУ =====
        Dim col As Long
        col = 2  ' Начинаем со 2-й колонки (в 1-й имя файла)
        
        For i = 0 To UBound(textParts)
            Dim cleanText As String
            cleanText = Trim(textParts(i))
            
            ' Пропускаем пустые строки (если нужно)
            If cleanText <> "" Then
                sh.Cells(r, col) = cleanText
                col = col + 1
            End If
        Next i
        
        doc.Close False
        r = r + 1
        f = Dir()
    Loop
    
    wd.Quit False
    MsgBox "Готово! Обработано " & r - 2 & " файлов"
End Sub