Récupérer Code postal parmis une adresse complète

Option Explicit
Dim Var As Variant
Dim result As String
Sub For_X_to_Next_Ligne()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long
Dim longueur As Integer
    Set FL1 = Worksheets(ActiveSheet.Name)
    NoCol = 1 'lecture de la colonne A
    For NoLig = 1 To Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne colonne A
     Var = FL1.Cells(NoLig, NoCol)
     If Var = "" Then
     Else
    FL1.Cells(NoLig, NoCol).Select
 extraireValeursNumeriques_DansChaine
longueur = Len(result) 'longueur  chaine numerique
 If longueur = 5 Then
 FL1.Cells(NoLig, NoCol + 1) = result 'code postal dans colonne B
  FL1.Cells(NoLig, NoCol) = Replace(FL1.Cells(NoLig, NoCol), result, "") 'supprime code postal dans la colonne A si utilité, sinon supprimer la ligne de code
 End If
End If
Next
    Set FL1 = Nothing
End Sub
Sub extraireValeursNumeriques_DansChaine()
    Dim i As Byte, nb As Byte
    Dim Cible As String, Resultat As String
    Dim Nombre As Double
     Cible = Var
    'Pour que fonction Val puisse reconnaitre les décimales: Remplacement des
    'virgules par des points
    Cible = Replace(Cible, ",", ".")
    'Pour gérer deux nombres qui se suivent: remplacement des espaces
    'par un caractère Alpha
    Cible = Replace(Cible, " ", "x")
    
    For i = 1 To Len(Cible)
        If IsNumeric(Mid(Cible, i, 1)) Then
        Nombre = Val(Mid(Cible, i, Len(Cible) - i + 1))
        nb = nb + 1
        Resultat = Resultat & Nombre & vbLf
        i = i + Len(Str(Nombre)) - 1
        End If
    Next
   result = Nombre
End Sub
Private Sub CommandButton1_Click()
For_X_to_Next_Ligne
End Sub