VBA ArrayDictionary ajouter ligne

Bonjour

J'ai un tableau que je voudrais dynamique alimenté par ligne par le dictionary, mais je ne réussi pas à insérer les lignes suivantes dans le tableau dynamique.

Pour résumer toutes les lignes de 6 à 10 doivent être inserer progressivement dans le tableau.
la premierre ligne passe, a la deuxième message erreur

merci




Sub Redim_Transpose_Array()


'Dim My_Array_Dynamic() As Variant

Dim lig As Integer, Col As Integer, i As Integer


For lig = 6 To 10
For Col = 5 To 9

i = i + 1

ReDim My_Array_Dynamic(1 To i, 1 To 5)


Set Mondico = CreateObject("Scripting.Dictionary")

For Each c In Sheets("feuil2").Range("E" & 6 & ":" & "i" & lig)

If Not Mondico.exists(c.Value) Then Mondico.Add c.Value, c.Value

My_Array_Dynamic = Mondico.items

Next



My_Array_Dynamic = Application.Transpose(My_Array_Dynamic)

ReDim Preserve My_Array_Dynamic(1 To 5, 1 To i)


My_Array_Dynamic = Application.Transpose(My_Array_Dynamic)

Sheets("feuil2").Cells(lig, 20).Resize(i, 5) = My_Array_Dynamic

next
next