Function ТЕКСТWORD(wfn As String) As String 'Получить текст из Word
    Dim objWrdApp, objWrdDoc, Tabl As Object, i As Long
    On Error Resume Next
        Set objWrdApp = GetObject(, "Word.Application")
        If objWrdApp Is Nothing Then
            Set objWrdApp = CreateObject("Word.Application")
            Set objWrdDoc = objWrdApp.Documents.Open(wfn)
            objWrdApp.Visible = False
        End If
        Set objWrdDoc = objWrdApp.Documents.Open(wfn)
        ТЕКСТWORD = objWrdDoc.Range.Text
        objWrdDoc.Close SaveChanges:=False
        Set objWrdDoc = Nothing
        Set objWrdApp = Nothing
End Function

Sub Extract_TD_text()     
    Set IE = New InternetExplorer
    IE.Visible = True
    For i = 1 To Worksheets(ShRN).Cells(Rows.Count, 1).End(xlUp).Row
        URL = Worksheets(ShRN).Cells(i, 1).Value
        IE.navigate URL
        While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE: DoEvents: Wend
        Set HTMLDoc = IE.Document        
        For Each ele In HTMLDoc.all.tags("table")
          ...
        Next
        Set HTMLDoc = Nothing
    Next i
    IE.Quit
    Set IE = Nothing
End Sub

Sub Sel_Clean()
Dim rCell As Range
    For Each rCell In Selection.Cells
        rCell.Value = Application.Trim(Application.Clean(rCell.Value))
    Next rCell
End Sub