Sub clearPage()
With Feuil2
derlig = .Cells(Rows.Count, "A").End(xlUp).Row
If derlig <= 18 Then Exit Sub
.Range("A19:A" & derlig).EntireRow.Delete
For I = Feuil2.Shapes.Count To 2 Step -1: DoEvents: Feuil2.Shapes(I).Delete: Next
Range("F4,A8:F8,C10:E10,C12,C13,A16:F16,A18").ClearContents
End With
End Sub
Sub createcopy()
Dim F As Worksheet, plage1 As Range, I&, cel As Range, cell As Range, A&
clearPage
Set F = Feuil2
Set plage1 = F.[A1:G19]
'ecriture des données
With F
.[A8] = Feuil1.[b4]
.[c10] = Feuil1.[b7]
.[c12] = Feuil1.[b10]
.[c13] = Feuil1.[b13]
.[A16] = Feuil1.[B19]
.[A18] = Feuil1.[B22]
End With
nombre = Feuil1.[b25]
For I = 1 To nombre - 1
Set cel = F.Range("A" & (19 + 1) * I)
plage1.Copy cel
F.Shapes(I + 1).Top = cel.Top + 10
F.Shapes(I + 1).Left = 15
If I Mod 3 = 0 Then F.HPageBreaks.Add Before:=cel ' 1 invit par feuille A4 (mettre mod 2 pour imprimer deux invit par feuille)
cel.Offset(1, 6) = I + 1
Next
F.PrintPreview
End Sub