Macro créer automatiquement fichier avec différents onglets selon la date

Bonjour à tous, je vous explique mon problème.
J'ai un fichier central avec mes onglets remplis (onglet 1 : tableau, onglet 2 : bd). J'aimerais en lançant ma macro effectuer une demande à l'utilisateur pour qu'il puisse renseigner son nom, le mois en cours et l'année en cours. Ainsi un Nouveau fichier serait créé avec pour nom : "Nom_mois_annee_toto.xls".
De plus il faudrait que dans ce nouveau fichier, autant d'onglets qu'il y a de semaines dans le mois renseigné soient créés tout en gardant le tableau présent dans l'onglet 1, de plus pour chaque onglet il faudrait pouvoir marquer dans une case, les 7 jours de la semaine.

ex : Fichier central : Début de la Macro j'entre nom= tibtelcom, annee= 2009, mois = 10 (octobre). Ainsi un nouveau fichier nommé "Tibtelcom_10_2009_toto.xls" est créé
l'onglet 1 s'appelle sem1
l'onglet 2 s'appelle sem2
l'onglet 3 s'appelle sem3
l'onglet 4 s'appelle sem4
l'onglet 5 s'appelle sem5
l'onglet 6 est ma bd
dans les onglets 1 à 5 figure le tableau présent dans l'onglet 1 du fichier central et dans les cases A1, B1, C1, D1, E1, F1, G1 sont inscrit les jours de la semaine : sem1!A1= lundi 28 sept ; sem1!B1=Mardi 29 sept ; sem1!G1 = dimanche 4 oct.
sem2!A1 = lundi 5 oct .....;

J'ai un début de code que j'ai récupéré pour créer les onglets mais comment faire pour que dans ces onglets figure mon tableau du fichier central ??

Sub Macro1()
Dim premierJour, i As Integer, y As Integer, z As Integer
Dim Annee As Integer, Mois As Integer
Annee = InputBox("Entrer l'année")
Mois = InputBox("Entrer le mois")
premierJour = DateSerial(Annee, Mois, 5) - Weekday(DateSerial(Annee, Mois, 5))
For i = 1 To 5
Sheets.Add After:=Worksheets(Sheets.Count)
ActiveSheet.Name = "SEM" & i
For y = 1 To 5
Cells(1, y) = CDate(premierJour) + z
z = z + 1
Next y
Range("A1:E1").NumberFormat = "dddd d mmmm"
z = z + 2
Range("b3").Value = "Sem" & i
Next i
End Sub


Merci Beaucoup