XL 2016 Saisie semi-automatique (VBA ou formule mais pas en insérant des objets)

'-----------------------
'Initialisation UserForm
'-----------------------
Private Sub UserForm_Initialize()
    Dim i As Integer
    Dim Z As Double
    Dim ptopx As Double
   Dim cel As Range
   Me.StartUpPosition = 0
   Set cel = ActiveSheet.Range(CelluleTableauListe)
    With ActiveWindow.ActivePane
        Z = .Parent.Zoom / 100
        ptopx = (.PointsToScreenPixelsX(72) - .PointsToScreenPixelsX(0)) / 72  'coeff point to pixel

        'Positionnement du UserForm au dessus de la cellule du tableau de la liste des évènements à sélectionner

        Me.Top = .PointsToScreenPixelsY(0) / ptopx + cel.Top * (Z) - Me.Height
        Me.Left = .PointsToScreenPixelsX(0) / ptopx + cel.Left * (Z)
    End With

    'Charge les évènements en table
    TabÉvènements = Range("Tableau1").Value

    'Charge la table des évènements épurés
    ReDim TabÉvènementsÉpurés(1 To UBound(TabÉvènements, 1))
    For i = 1 To UBound(TabÉvènements, 1)
        TabÉvènementsÉpurés(i) = ÉpurerChaine(CStr(TabÉvènements(i, 1)))
    Next i

    'Créer le tableau de la liste des évènements à sélectionner
    Call CréerTableauListe

    'Valorise tableau de la liste des évènements à sélectionner
    Call ValoriserTableauListe

    'Place le curseur en TextBox
    Me.TextBox1.Text = ""
End Sub

ReDim TabÉvènementsSélection(1 To UBound(TabÉvènements, 1))
        For i = 1 To UBound(TabÉvènements, 1)
            TabÉvènementsSélection(i) = TabÉvènements(i, 1)
        Next i

TabÉvènementsSélection=application.transpose(TabÉvènements)

Do While 1
            If Len(TexteÉpuré) = Len(Replace(TexteÉpuré, "  ", " ")) Then Exit Do
            TexteÉpuré = Replace(TexteÉpuré, "  ", " ")
        Loop

       Do While Len(TexteÉpuré) <> Len(Replace(TexteÉpuré, "  ", " "))
            TexteÉpuré = Replace(TexteÉpuré, "  ", " ")
        Loop