Sub adresses()
Dim i&, J&, X&, Tablo(), Var(1 To 1), Ville$, Rue$
With Sheets("Feuil1")
For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row - 2 Step 4
J = J + 1
ReDim Preserve Tablo(1 To 4, 1 To J)
Temp = Split(.Cells(i + 2, 1), " ")
For K = 1 To UBound(Temp)
If IsNumeric(Temp(K)) Then
Var(1) = K
Exit For
End If
Next K
Tablo(1, J) = Mid(.Cells(i, 1), 4, Len(.Cells(i, 1)) - 4)
For X = 0 To Var(1) - 1
Rue = Rue & " " & Temp(X)
Next X
Tablo(2, J) = Rue
Tablo(3, J) = Temp(Var(1))
For X = Var(1) + 1 To UBound(Temp)
Ville = Ville & " " & Temp(X)
Next X
Tablo(4, J) = Ville
Erase Var
Ville = ""
Rue = ""
Next i
.Cells(5, 7).Resize(UBound(Tablo, 2), UBound(Tablo, 1)) = Application.Transpose(Tablo)
End With
End Sub