Sub CreerFicheUnique()
Application.ScreenUpdating = False
Dim tabloListe() As Variant
With Sheets("Liste")
tablo = .UsedRange.Value 'on place toutes les données de la feuille Liste dans un tablo vba
End With
ActiveWorkbook.Sheets.Add 'on créé une nouvelle feuille vierge
ActiveSheet.Name = "Fiches Produits" 'donne "Fiches Produits" comme nom de la nouvelle fiche
Sheets("Fiche vierge").Rows("1").Copy Sheets("Fiches Produits").Rows("1") 'on recopie la première ligne
For i = LBound(tablo, 1) + 1 To UBound(tablo, 1) 'pour chaque ligne du tablo
With Sheets("Fiches Produits")
Fin = .UsedRange.Rows.Count + 1 'on detecte la dernière ligne de la feuille
Sheets("Fiche vierge").Rows("2:21").Copy .Rows(Fin) 'on y colle le "modèle" de fiche
Debut = Fin + 4 'on calcule la première ligne de cette nouvelle fiche
.Range("D" & Debut) = tablo(i, 4) 'libelle en D6
.Range("D" & Debut + 1) = tablo(i, 13) 'fournisseur en D7
.Range("D" & Debut + 2) = tablo(i, 8) 'EAN en D8
End With
Next i
Application.ScreenUpdating = True
End Sub