Sub ReadWord()
Dim Sh As Worksheet
    Set app = CreateObject("Word.Application")
    app.Visible = True
    Set docAct = app.Documents.Open("Путь к файлу ворда")
        Set Tb = docAct.Tables(1)
    ReDim x(1 To 2, 1 To Tb.Rows.Count)
    For n = 1 To Tb.Rows.Count
        A = Split(Tb.Rows(n).Cells(1).Range.Text, Chr(13))(0)
        B = Split(Tb.Rows(n).Cells(2).Range.Text, Chr(13))(0)
        x(1, n) = A
        x(2, n) = B
    Next
    Set Sh = ActiveSheet
   LastRow = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row+1
    Sh.Range("A" & LastRow).Resize(2, UBound(x, 2)) = x
docAct.Close
Set docAct = Nothing
  app.Quit
  Set app =Nothing
End Sub