Extracting information into fields

[emshac]

I have just exported some 200 contacts from Word document into Excel sheet and they look somewhat like this:

[TABLE="width: 272"]
<colgroup><col></colgroup><tbody>[TR]
[TD]Title: Mr. [/TD]
[/TR]
[TR]
[TD]First name: R[/TD]
[/TR]
[TR]
[TD]Last name: Miles [/TD]
[/TR]
[TR]
[TD]Email address: rmiles@*** [/TD]
[/TR]
[TR]
[TD]Address 1: 1 Lane [/TD]
[/TR]
[TR]
[TD]Address 2: Burton [/TD]
[/TR]
[TR]
[TD]Postcode: E** 8*K [/TD]
[/TR]
[TR]
[TD]Town: Somewhere [/TD]
[/TR]
[TR]
[TD]State / Province: UK [/TD]
[/TR]
[TR]
[TD]Country: United Kingdom [/TD]
[/TR]
[TR]
[TD]Phone : +44 78504*****

All of this info is in cell A1 - A11, where the fields and the information given aren't separated into different columns.
This is repeated for the other 200 contacts. Meaning to say, the information starts at A1 and ends at A498.


I am trying to create a database that would allow me to extract all this information and allocate them neatly into fields in columns. Does anyone know how to extract this or use a macro that could make the task easier so I don't have to manually fill in 200 contacts into the respective fields?

Thanks! [/TD]
[/TR]
</tbody>[/TABLE]

 

[Marcílio_Lobão]

emshac, Good afternoon.

Suppose your data is at column A, starting A1.

Try to use:

B1 -->
=MID(INDIRECT("A"&COLUMN()-1+((ROW(A1)-1)*11)),FIND(":",INDIRECT("A"&COLUMN()-1+((ROW(A1)-1)*11)))+2,100)

Copy it side till L1

Select B1:L1
Copy it down as necessary

I did an example for you:
21-09-2015_Rebuilding_NEW_Layout-OK.xlsx

Is that what you're looking for?
I hope it helps.

 

[Learning To Excel]

There may be a better way to extract it. But even if there isn't the result it's giving you can easily be manipulated. For example this will copy everything below the first 11 and put it next to the first 11. I am assuming that the labels aren't actually there, but if they are you could make a macro to eliminate those as well.

Sub Placer()
Dim i As Integer
Dim j As Integer
j = 1


    For i = 11 To 498 Step 11
        Range(Cells(i - 10, 1), Cells(i, 1)).Copy Destination:=Cells(1, j)
        j = j + 1
    Next i


End Sub