XL 2019 renvoye lettre

Sub Dissèque()
Dim tablo()
Range("B2:Z1000").ClearContents
NL = Application.CountIf(Range("A:A"), "*")
For L = 2 To NL
N = Cells(L, 1)
ReDim tablo(Len(N))
For i = 1 To Len(N)
    tablo(i) = Mid(N, i, 1)
Next i
For i = 1 To Len(N)
    For j = 1 To Len(N)
        If LCase(tablo(i)) < LCase(tablo(j)) Then
            Buffer = tablo(i)
            tablo(i) = tablo(j)
            tablo(j) = Buffer
        End If
    Next j
Next i
For i = 1 To UBound(tablo)
    Cells(L, i + 1) = UCase(tablo(i))
Next i
Next L
End Sub

=STXT($A1;COLONNES($A:A);1)