Copier coller avec 1 condition dans une nouvelle feuille.

Sub Dupliquer()
Dim t, ncol%, rest(), i&, j&, n&, k%
t = [A1].CurrentRegion 'matrice, plus rapide
ncol = UBound(t, 2)
ReDim rest(1 To Application.Sum(Application.Index(t, 0, 2)) + 1, 1 To ncol)
'---remplissage du tablau---
For i = 2 To UBound(t)
  For j = 1 To t(i, 2)
    n = n + 1
    For k = 1 To ncol
      rest(n, k) = t(i, k)
    Next
    rest(n, 2) = 1
  Next
Next
'---restitution---
With Sheets("Résultat")
  .Rows("2:" & .Rows.Count).Delete 'RAZ
  .[A2].Resize(n + 1, ncol) = rest
  .Activate
End With
End Sub