Modifier une liste (genre base de données)

Sub Macro1()
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim d As Range 'déclare la variable d (cellule de Destination)

With Sheets("Feuil1") 'prend en compte l'onglet "Feuil1"
    .Range("D1").CurrentRegion.Clear 'efface les éventuelles anciennes données
    dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne dl de la colonne 1 (=A)
    Set pl = .Range("A2:A" & dl) 'définit la plage pl
    .Range("A1:B1").Copy .Range("D1") 'copy la plage A1:B1 et la colle en D1
    For Each cel In pl 'boucle 1 : sur toutes les cellules cel de la plage pl
        For i = 0 To UBound(Split(cel.Offset(0, 1).Value, ";")) 'boucle 2 : sur toutes les mots délimités entre les points-virgule
        Set d = .Cells(Application.Rows.Count, 4).End(xlUp).Offset(1, 0) 'définit la cellule de destination d
            d.Value = cel.Value 'place la valeur de la cellule cel dans d
            d.Offset(0, 1).Value = Split(cel.Offset(0, 1).Value, ";")(i) 'récupère le nom entre deux points-virgule
        Next i 'prochain mot de la boucle 2
    Next cel 'procaine cellule de la boucle 1
End With 'fin de la prise en compte de l'onglet "Feuil1"
End Sub

Sub essai()
  Set d1 = CreateObject("scripting.dictionary")
  For Each c In Range("a2:a" & [a65000].End(xlUp).Row)
    a = Split(c.Offset(, 1).Value, ";")
    For Each m In a: d1(m) = c: Next m
  Next c
  [i2].Resize(d1.Count) = Application.Transpose(d1.keys)
  [h2].Resize(d1.Count) = Application.Transpose(d1.items)
End Sub