XL 2016 Comment extraire une série de lettre et chiffre qui peuvent varier (H1H1H1)

Sub Test()
Dim Temoin  As String
Dim Lettre  As String
Dim Mot     As Variant
Dim Cell    As Range
Dim Plage  As Range
Dim I       As Integer

   ' Range de cellules à examiner :
    Set plage = [A1:A2]
 
    For Each Cell In plage
        For Each Mot In Split(Cell)
            If Len(Mot) = 6 Then
                Temoin = ""
                For I = 1 To Len(Mot)
                    Lettre = Mid(Mot, I, 1)
                    Temoin = Temoin & IIf(IsNumeric(Lettre), "0", "H")
                Next
                If Temoin = "H0H0H0" Then
                    I = InStr(Cell, Mot)
                   ' Début utile de la phrase
                    Cell.Offset(0, 1) = Trim(Left(Cell, I - 1))
                   ' Partie extraite
                    Cell.Offset(0, 2) = Mid(Cell, I)
                    Exit For
                End If
            End If
        Next
    Next

End Sub

Function Extrait(Chaine)
Dim tablo, i As Integer, j As Integer
Application.Volatile
tablo = Split(Chaine, " ")
For i = 0 To UBound(tablo)
    If Len(tablo(i)) = 6 Then   ' on traite les mots de 6 caractères
        Mot = tablo(i)
        If IsNumeric(Mid(Mot, 2, 1)) And IsNumeric(Mid(Mot, 4, 1)) And IsNumeric(Mid(Mot, 6, 1)) And _
            Not IsNumeric(Mid(Mot, 1, 1)) And Not IsNumeric(Mid(Mot, 3, 1)) And Not IsNumeric(Mid(Mot, 5, 1)) Then
            For j = i To UBound(tablo)
                Extrait = Extrait & " " & tablo(j)
            Next j
            Exit Function
        End If
    End If
Next i
End Function