String separation to another Column

Hello again,

I'm on the edge here trying to optimize a code built by another person.
So i have two columns
The one has some addresses like:
Aetideon 36 Athens
Iroon Politexneiou 55 Cholargos
Statigou Makrigianni 27B Koridallos

All the addresses are taken from another excel file.
What i want to do is to take everything after the number values and place it into the next column and delete it from the current one

The code used is this:

Please Login or Register  to view this content.

As you can see there was more than the addresses that i've given.
I've managed to get this far but now it seems i'm stuck.
The value is stored here:
destws.Range("Z" & i).Value = addrAA

Note: Sometimes as you can see some addresses have a string Value Next to them. I want to separate the words that have space between them and are on the right of the number Values.
Thanks in advance.

The original format is like this:

ΗΡΑΚΛΕΙΔΩΝ 36 ΑΘΗΝΑ 11851 ΑΤΤΙΚΗΣ
ΗΡΩΩΝ ΠΟΛΥΤΕΧΝΕΙΟΥ 23 ΑΓ.ΣΤΕΦΑΝΟΣ 14565 ΑΤΤΙΚΗΣ
ΠΥΡΓΙΩΤΙΣΣΗΣ 29 ΠΕΡΙΣΤΕΡΙ 12136 ΑΤΤΙΚΗΣ
ΤΡΥΠΙΑ 26 Β ΠΕΥΚΗ 15121 ΑΤΤΙΚΗΣ
EYΓENΩN 5 - ΠEPIΣTEPI 12134
ΡΟΔΟΠΗΣ 19-21 ΒΡΙΛΗΣΣΙΑ 15235 ΑΤΤΙΚΗΣ
Α ΜΠΕΡΤΟΥ 29 ΚΕΡΑΤΣΙΝΙΟΥ - ΔΡΑΠΕΤΣΩΝΑΣ 18758 ΑΤΤΙΚΗΣ
ΔΕΛΗΓΙΑΝΝΗ 8 ΠΕΙΡΑΙΑΣ 18233 ΑΓ ΙΩΑΝΝΗΣ ΡΕΝΤΗΣ
ΠΟΛΥΒΙΟΥ ΔΗΜΗΤΡΑΚΟΠΟΥΛΟΥ 17 ΑΘΗΝΑΙΩΝ 11141 ΑΤΤΙΚΗΣ
ΚΡΙΕΖΗ 54 ΜΑΡΟΥΣΙ 15125 ΑΤΤΙΚΗΣ
ΙΑΣΟΝΟΣ 2 ΠΑΛΑΙΟΥ ΦΑΛΗΡΟΥ 17564 ΑΤΤΙΚΗΣ
ΣΠΟΡΓΙΛΟΥ 10 ΑΘΗΝΑ 11362 ΑΤΤΙΚΗΣ
ΑΝΘΕΩΝ 4 ΑΓΙΑΣ ΠΑΡΑΣΚΕΥΗΣ 15342 ΑΤΤΙΚΗΣ
ΣΕΒΑΣΤΙΑΣ 33 ΝΕΑ ΣΜΥΡΝΗ ΑΤΤΙΚΗΣ 17122 ΑΤΤΙΚΗΣ
ΜΑΥΡΟΚΟΡΔΑΤΟΥ 69 ΠΕΙΡΑΙΑΣ 18538 ΑΤΤΙΚΗΣ
ΚΟΜΝΗΝΩΝ ΑΡΓΟΝΑΥΤΩΝ 5 ΔΡΟΣΙΑ 14572 ΑΤΤΙΚΗΣ
ΑΧΙΛΛΕΩΣ 4 ΗΡΑΚΛΕΙΟ 14121 ΑΤΤΙΚΗΣ
ΤΙΜΙΟΥ ΣΤΑΥΡΟΥ 14 ΑΧΑΡΝΕΣ 13671 ΑΤΤΙΚΗΣ

ok so i tried this kind of code:

Sub Extract_Text()
Dim sh As Worksheet, cell As Range, rng As Range
Dim k As Double, num As Boolean, cad As String

Set sh = Sheets("cases_P")
Set rng = sh.Range("Y2", sh.Range("Y" & Rows.Count).End(xlUp))

For Each cell In rng
num = False
cad = ""
For k = 1 To Len(cell.Value)
If Mid(cell.Value, k, 1) Like "[0-999]" Then
cad = Mid(cell.Value, 1, k)
num = True

Else
If num Then
If Mid(cell.Value, k, 1) <> " " Then cad = Mid(cell.Value, 1, k)

Exit For
Else
cad = cell.Value


End If
End If
Next

sh.Cells(cell.Row, "Y").Value = cad
sh.Cells(cell.Row, "Z").Value = WorksheetFunction.Trim(Mid(cell.Value, Len(cad) + 1))

Next

MsgBox "End"

End Sub

My problem is that i cant' get to print anything after the street number in column Z.
Can anyone help me?