copie d'onglets: la macro bug à 35 onglets

Bonjour à tous,
XP excel 2003 ou 2007
sur un fichier, une macro est censée recopier une feuille modèle, autant de fois qu'on a besoin de semaines
En clair si un projet se déroule sur 50 semaines, le modèle est recopié et renommé selon les semaines ciblées.
PB: elle bug au dela de 35 feuilles
kekun saurait-y m'aider la dessus?
Je ne peux joindre le fichier, car même compréssé, il fait 94ko
je joins juste la macro ci dessous

Merci
gilles

Sub CopieToutesSem()
'S 'il n'y a pas l'informatique sur chantier:
'Créer les onglets de toutes les semaines (le RA)
'copie l'onglet "semaine en cours" en autant de semaines que dure le chantier
'et affecte les Noms d'affaire et N° de semaine

Sheets("dates").Select
Range("H6:H1750").Select 'Activate
Dim Name As String
Dim Mycell As Range, Mysheet As Worksheet, MyName$
For Each Mycell In Selection 'liste de noms
MyName = Mycell.Value
If MyName <> "" Then
On Error Resume Next
Set Mysheet = Sheets(MyName)
On Error GoTo 0
If Mysheet Is Nothing Then Sheets("Semaine en cours").Copy Before:=Sheets("Semaine en cours")

'depuis semaine en cours (2) je recopie les heures sur semaine en cours
Sheets("Semaine en cours (2)").Select
Range("M10:M76").Select
Selection.Copy
Sheets("Semaine en cours").Select 'je recopie sur semaine en cours
Range("K10").Select
ActiveSheet.Paste Link:=True 'copie avec liaison
Application.CutCopyMode = False
'je renomme l'onglet
Sheets("Semaine en cours (2)").Select
Sheets("Semaine en cours (2)").Name = MyName
Application.ScreenUpdating = False
[K3].Value = "Semaine"
[M3] = ActiveSheet.Name
Range("M3").Select
Selection.Copy
Range("BE2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("O3").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-1]C[42],basedates,2,FALSE)"
Range("O2").Select

' ActiveSheet.PROTECT DrawingObjects:=True, Contents:=True, Scenarios:=True
' ActiveSheet.EnableSelection = xlUnlockedCells
End If
Next Mycell


'renomme l'onglet Semaine en cours et le met à la fin pour que
'l'utilisateur ne l'utilise pas

Sheets("Semaine en cours").Select
'
Range("K10:K76").Select
Range("K76").Activate
Selection.ClearContents
Sheets("Paramètres").Select
Sheets("Semaine en cours").Name = "vierge"
End Sub