Sub AjoutFeuilles_1()
Dim WS As Worksheet
Dim Plage1 As Range, Plage2 As Range
Dim Cell As Range
Set Plage1 = Worksheets("Menu").Range("B6:B7")
Set Plage2 = Worksheets("Menu").Range("C6:C" & Range("C65535").End(xlUp).Row)
For Each Cell In Plage2
If Cell.Value = "" Then GoTo TheNext
For Each WS In Worksheets
If WS.Name <> "Modele" Or WS.Name <> "Menu" Then
If WS.Name = Cell.Text Then GoTo TheNext
End If
Next WS
Sheets("Modele").Copy After:=Sheets(Sheets.Count)
On Error GoTo ErrorHandler
Sheets(Sheets.Count).Name = "PT_" & Cell.Text
With Sheets("PT_" & Cell.Text)
.Range("B4") = Cell.Text
.Range("B5") = "Période travaillée du " & _
Format(WorksheetFunction.Max(DateSerial(Cell.Value, 1, 1), Plage1(1)), "dd.mm.yyyy") & _
" au " & _
Format(WorksheetFunction.Min(DateSerial(Cell.Value, 12, 31), Plage1(2)), "dd.mm.yyyy")
End With
TheNext:
Next Cell
Exit Sub
ErrorHandler:
MsgBox "Le Nom " & Cell.Text & " n'est pas un nom de feuille valide, le traitement à été interrompu", vbCritical
End Sub