Recopie chaque ligne

Bonjour,

Je voudrai améliorer la macro pour que chaque recopie se fasse en double sur deux lignes consécutives.

Merci.

Ci-joint fichier explicatif.

bonjour,

Sub RecopieUneLigneSurDeux()

Application.ScreenUpdating = False

Range("B1").Select

  For Each Cellule In Range("A1", Range("A" & Rows.Count).End(xlUp))
     Selection = Cellule
     Selection.Offset(1, 0) = Cellule
     ActiveCell.Offset(2, 0).Select
  Next

End Sub

Cordialement

Je te remercie.

Cordialement.