Cree un onglet par semaine en automatique ?

Bonjour et bonne année à tous,

j'ai un fichier avec 52 onglets (52 semaine, nommé S1,S2,S3,...) et dans chaque onglet, de B1 à F1 les jours de la semaine (lundi à vendredi) et de B2 à F2 les dates des jours de la semaine.

J'ai un modele et j'ai recuperé cette macro qui n'est pas fonctionnel !

En effet, les jours se suivent bien, mais d'un onglet à l'autre les samedi et dimanche n'ont pas été pris en compte. De plus, la S1 commence le 02/01 au lieu du 04/01 et en l'année 1900 !

voici le code que j'utilise une seule fois et ensuite je renomme ce fichier en effacant l'onglet modele :

Sub creer_Annee()
'Const Annee As Integer = 2016 choix de l'année
Dim cptr As Byte, jour As Byte
Application.ScreenUpdating = False
For cptr = 2 To 53
 Sheets(1).Copy after:=Sheets(cptr - 1)
 With Sheets(cptr)
      .Name = "S" & cptr - 1
 'date du lundi de la semaine créée
      Sheets(cptr).Cells(1, 2) = 5 * (cptr - 1) + DateSerial(Annee, 1, 3) - Weekday(DateSerial(Annee, 1, 3)) - 5
      Sheets(cptr).Cells(2, 2) = 5 * (cptr - 1) + DateSerial(Annee, 1, 3) - Weekday(DateSerial(Annee, 1, 3)) - 5
       For jour = 2 To 5
         Sheets(cptr).Cells(1, jour) = .Cells(1, jour - 1) + 1
         Sheets(cptr).Cells(2, jour) = .Cells(2, jour - 1) + 1
       Next
 End With
Next

End Sub

Merci pour votre aide

Après recherche, jai trouvé cette macro qui est fonctionnel mais ne garde pas ma mise en page de ma feuille modele

Sub creer_Annee()
Dim premierLundi, i As Integer, y As Integer, z As Integer
 premierLundi = DateSerial(2016, 1, 5) - Weekday(DateSerial(2016, 1, 3))
 For i = 1 To 52
Sheets.Add After:=Worksheets(Sheets.Count)
ActiveSheet.Name = "S" & i
 For y = 2 To 6
 Cells(1, y) = CDate(premierLundi) + z
 Cells(2, y) = CDate(premierLundi) + z
 z = z + 1
 Next y
 Range("B1:F1").NumberFormat = "dddd"
 Range("B2:F2").NumberFormat = "d mmmm"
 z = z + 2

 Next i

End Sub

Voilà,

J'ai trouvé et cela fonctionne.

Sub creer_Annee()
Dim premierLundi, i As Integer, y As Integer, z As Integer
 premierLundi = DateSerial(2016, 1, 5) - Weekday(DateSerial(2016, 1, 3))
 For i = 1 To 52
Sheets(1).copy After:=Worksheets(Sheets.Count)
ActiveSheet.Name = "S" & i
 For y = 2 To 6
 Cells(1, y) = CDate(premierLundi) + z
 Cells(2, y) = CDate(premierLundi) + z
 z = z + 1
 Next y
 Range("B1:F1").NumberFormat = "dddd"
 Range("B2:F2").NumberFormat = "d mmmm"
 z = z + 2

 Next i

End Sub

Rien que le fait de posté, ce forum m'a inspiré.