XL 2019 copiage de données par VBA

Private Sub CommandButton1_Click()
Dim Valeurs(), cp As Long, Resultat(), lg As Long


Valeurs = Feuil1.Range("B2:F" & Feuil1.Range("B1000000").End(xlUp).Row).Value
For t = LBound(Valeurs, 1) To UBound(Valeurs, 1)
 
  For u = 1 To Valeurs(t, 5)
    lg = lg + 1
    ReDim Preserve Resultat(1 To 3, 1 To lg)
    Resultat(1, lg) = Valeurs(t, 1) & "F" & u
    Resultat(2, lg) = Valeurs(t, 3)
    Resultat(3, lg) = Valeurs(t, 4)
  Next


Next


Feuil2.Range("a2").Resize(UBound(Resultat, 2), UBound(Resultat, 1)) = Application.Transpose(Resultat)
Feuil2.Activate
End Sub