am not sure if this is exactly what you're seeking but it works on my
Office 2007
surely it might be simpler but at the moment I cannot come up with
anything better. let me know if you need variables and descriptions in
English.
--------
pls click YES if this helped
--------


Sub cus()
Dim wrd As Word.Application
Dim myrange As Word.Range
Dim wiersz As String
Dim numer_pytania As String
Dim tekst_pytania As String
Dim numer_PODpytania As String
Dim tekst_PODpytania As String
Dim pytanie As Integer
Dim PODpytanie As Integer

On Error Resume Next

ActiveSheet.UsedRange.Clear

Set wrd = New Word.Application
wrd.DisplayAlerts = wdAlertsNone

With wrd
..Documents.Open Filename:="C:\Eksele\przyklad.docx",
ConfirmConversions:=False, _
ReadOnly:=False, AddToRecentFiles:=False,
PasswordDocument:="", _
PasswordTemplate:="", Revert:=False,
WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto,
XMLTransform:=""
Dim ten_dok As Word.Document
Set ten_dok = .ActiveDocument



For i = 1 To 20 'ten_dok.Paragraphs.Count

PODpytanie = 2

a = .ActiveDocument.Paragraphs(i).Range.Start
a1 = .ActiveDocument.Paragraphs(i).Range.End

Set myrange = ten_dok.Range(Start:=a, End:=a1)


wiersz = myrange.Text

myrange.Select
myrange.Copy

'określ czy dany wiersz zawiera numer pytania
For j = 1 To Len(wiersz)
If Mid(wiersz, j, 1) = "." Then
pytanie = pytanie + 1
numer_pytania = Left(wiersz, j - 1)
tekst_pytania = Right(wiersz, Len(wiersz) - j)
pytanie = pytanie + 1
ActiveSheet.Cells(pytanie, 1) = numer_pytania
ActiveSheet.Cells(pytanie, 2) = tekst_pytania

'idziesz do kolejnego paragrafu
a = .ActiveDocument.Paragraphs(i + 1).Range.Start
a1 = .ActiveDocument.Paragraphs(i + 1).Range.End
Set myrange = ten_dok.Range(Start:=a, End:=a1)
wiersz = myrange.Text

'określ czy dany wiersz zawiera numer PODpytania
For k = 1 To Len(wiersz)
If Mid(wiersz, k, 1) = ")" Then
'wyszukaj kolejny nawias
tekst_PODpytania = Right(wiersz, Len(wiersz) - k)
PODpytanie = PODpytanie + 1
ActiveSheet.Cells(pytanie, PODpytanie) = tekst_PODpytania

For l = 1 To Len(tekst_PODpytania & ")")
If Mid(tekst_PODpytania & ")", l, 1) = ")" Then
znajdz_kolejny_nawias = l
Exit For
End If
Next l

If k + Len(tekst_PODpytania) = Len(wiersz) Then
ActiveSheet.Cells(pytanie, PODpytanie) = Mid
(tekst_PODpytania, 1, znajdz_kolejny_nawias - 2)
Else
Exit For
End If

End If

Next k

Exit For
End If
Next j


Next i
End With

ten_dok.Close
wrd.Quit
Set wrd = Nothing

End Sub


On 23 Maj, 12:30, Francis wrote:
Pls ignore my earlier as I press enter too fast.

I have a Word document which contents shows as :

1.Apart from formal legal education, what alternative qualification is
necessary for a legal assistant?

a)a qualification in a related discipline
b)there is no alternative
c)many years of practical experience
d)membership with a recognized association

2.Who supervises a legal assistants work?

a)the Supreme Court
b)the Managing Director
c)a notary public
d)an attorney
e)no one

How do I import these to give me :
Col A = question number
Col B = questions
Col C = answer a)
Col D = answer b)
Col E = answer c)
Col F = answer d)
Col G = answer e)

TIA
--
Hope this is helpful

Pls click the Yes button below if this post provide answer you have asked

Thank You

cheers, francis

Am not a greek but an ordinary user trying to assist another