Sub creationFeuilles()
With Sheets("Sheet1")
Set trouve = .Range("A:A").Find("Véhiposte SAS - Détail des dépenses refacturées", LookAt:=xlWhole, LookIn:=xlValues)
If Not trouve Is Nothing Then
firstAddress = trouve.Address
Do
Sheets("Modèle").Copy after:=Sheets(Sheets.Count)
Set newSh = Sheets(Sheets.Count)
newSh.Name = trouve.Offset(2, 1) & "-" & trouve.Offset(3, 3)
débutListe = trouve.Row + Application.Match("Type de dépense", trouve.Resize(15, 1), 0)
fin = .Range("A" & débutListe).End(xlDown).Row
.Range("A" & débutListe & ":S" & fin + 2).Copy newSh.Range("A15")
With newSh
.[B9] = trouve.Offset(1, 1)
.[D9] = trouve.Offset(1, 3)
.[B10] = trouve.Offset(2, 1)
.[B11] = trouve.Offset(3, 1)
derlig = .Range("A15").CurrentRegion.Rows.Count + 15
.Range("A15:S" & derlig - 2).Borders.LineStyle = xlContinuous
With .Range("Q" & derlig).Resize(1, 3)
.Font.Bold = True
.Interior.Color = RGB(227, 227, 227)
.Borders.LineStyle = xlContinuous
End With
End With
Set trouve = .Range("A:A").FindNext(trouve)
Loop While Not trouve Is Nothing And trouve.Address <> firstAddress
End If
End With
End Sub