kodları aşağıdaki gibi düzenleyip dener misiniz?
Not: A sütunundaki yollar önce diziye aktarılıp sonra sayfa silindiği için hata ihtimaline karşı kodu çalıştırmadan önce dosya yolları başka yere kaydedilmeli

Public Sub Word2Text(ByVal xFilePath As String, ByVal xSatir As Long)  'Word2Text "d:\Desktop\Word2Excel\19 - Vba Class Modules.docx"



   Dim x As Document

   Set x = Documents.Open(xFilePath, ReadOnly:=True, Visible:=False)

   Dim data

   Set data = x.Content

   ' do something with the content or the document

   xStr = data

   Sayfa1.Cells(xSatir, 1) = xFilePath

   For HrfSay = 1 To Len(data & "") Step 30000

        Sayfa1.Cells(xSatir, 2) = Mid(xStr, HrfSay, 30200)

        xSatir = xSatir + 1

   Next HrfSay

   'close the document

   x.Close

   Set x = Nothing



End Sub

Sub WordAd()

t1 = Timer

Application.ScreenUpdating = False

Set sht = ThisWorkbook.Worksheets("WordXL")

      SonStr = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

Dim Dz As Variant

Dz = sht.Range("A2:A" & SonStr)

DsSay = UBound(Dz)

Debug.Print DsSay

sht.Range("A2:A" & SonStr).Cells.Clear

    For Each xWord In Dz

    i = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row + 1

       Word2Text xWord, i

    Next xWord



Application.ScreenUpdating = True

'Debug.Print "Normal Aktarım Tamam! " & vbNewLine & "Süre : " & Timer - t1 & " saniye " & vbNewLine & "Aktarılan Dosya sayısı : " & DsSay

   MsgBox "Aktarım Tamam! " & vbNewLine & "Süre : " & (Timer - t1) & " saniye " & vbNewLine & "Aktarılan Dosya sayısı : " & DsSay

End Sub

---

isterseniz dosya yolları bir sayfada durur işlem başka sayfada yapılır