If the data had been as you previously described, and perhaps only lacked 'Address 2' for some records, it could have been extracted and exported to Excel will little or no post-processing clean-up required. However, what you've posted suggests some records may or may not have 'Address 3', 'Town' and 'Country' fields as well. Consequently, where there are less than the maximum of 8 data lines, there is no way a macro could reliably differentiate between records that lack 'Address 2', and/or 'Address 3' and/or 'Town' and/or 'Country'. Therefore, a considerable amount of post-processing cleanup is likely to be required.
Some of your cells also have extraneous empty paragraphs before/after the data.
It's also still not clear from what you've posted as to whether the names need to be split in any way (eg title, initials, surname) and, if so, how variable the data in that row are.
Here is a macro that extracts the table data and outputs it as a text file in the CSV format. Excel should be able to open that directly. As previously mentioned, though, you may need to do a fair bit of manual post-processing. Note, too, that the code modifies your document as well, so you might want to close it without saving the changes (which reflect the way the data will be exported to Excel) after the csv file is created.
Code:
Sub Export()
Dim i As Long, j As Long, k As Long, Rng As Range
Dim DataFile As String, StrData As String
DataFile = "C:\Users\" & Environ("UserName") & "\Documents\Data.CSV"
StrData = "Name,Address 1,Address 2,Address 3,Town,City,PostCode,Country" & vbCr
With ActiveDocument
With .Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[^13]{2,}"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
With .Tables(1).Range
For i = 1 To .Cells.Count
Set Rng = .Cells(i).Range
With Rng
.End = .End - 1
If .Start <> .End Then
If Len(Trim(.Paragraphs(1).Range.Text)) < 3 Then .Paragraphs(1).Range.Text = vbNullString
k = .Paragraphs.Count
For j = k To 6
.Paragraphs(Int(k / 2)).Range.InsertAfter vbCr
Next
End If
StrData = StrData & Replace(.Text, vbCr, ",") & vbCr
End With
Next
StrData = Replace(Replace(StrData, Chr(12), vbNullString), vbCr & vbCr, vbCr)
MsgBox StrData
End With
End With
Open DataFile For Output As #1
Print #1, StrData
Close #1
End Sub