Coller une valeur autant de fois que le nombre de données

Bonjour,

j'ai une macro qui vient me copier plusieurs données de plusieurs feuilles pour les regrouper dans une seule feuille.

Voilà mon probl :

je viens coller les données de la feuille 2 et ensuite ceux de la feuille 3 (etc) ... entre les deux je souhaite prendre la valeur en D1 de chaque feuille et la coller dans la feuille 1 autant de fois que de valeur collé dans chaque feuille.

ci-joint un exemple pour plus de compréhension

merci d'avance

Bonjour

Macro à tester

Sub regroupement()
Dim Nblg As Long, Ligne As Long
Dim Ws As Worksheet

  Application.ScreenUpdating = False

  With Sheets("Feuil1")
    .Range("A2:B1000").Clear
    For Each Ws In Sheets(Array("Feuil2", "Feuil3"))
      Ligne = .Range("A" & Rows.Count).End(xlUp).Row + 1
      Nblg = Ws.Range("A" & Rows.Count).End(xlUp).Row
      Ws.Range("A2:A" & Nblg).Copy Destination:=.Range("A" & Ligne)
      Ws.Range("D1").Copy .Range("B" & Ligne).Resize(Nblg - 1)
    Next Ws
  End With
End Sub

Bonjour,

merci beaucoup ça marche nickel