Sub aa()
Dim R As Range
Dim C As Range
Dim var
Dim j&
Dim i&
Dim A$
'---
Set R = Range("a1:iv1") 'l'astuce est de définir la plage en ligne 1 de colonne A à colonne IV
var = R
For Each C In R
j& = j& + 1
A$ = C.Address(False, False)
For i& = 1 To Len(A$)
If IsNumeric(Mid(A$, i&, 1)) Then
Exit For
A$ = ""
Else
var(1, j&) = var(1, j&) & Mid(A$, i&, 1)
End If
Next i&
Next C
'--- Inscription ---
Range("a1:a" & UBound(var, 2)) = Application.WorksheetFunction.Transpose(var)
End Sub