macro création fichier + dossier

Sub Go()
  ' Définir une variable pour le chemin
  Dim Chemin2 As String
  ' Définir une variable pour le nom du dossier
  Dim sDos As String
  ' Définir le chemin d'accès par défaut
  Chemin2 = "C:\Documents and Settings\PRAT.M\Mes documents\Fichier hebdo\2013\"
  'Chemin2 = ThisWorkbook.Path & "\"
  
  ' Récupérer le nom du dossier en cellule A1
  sDos = Sheets("Séjours à coder").Range("A1")
  
  ' Vérifier si ce dossier existe, grâce à l'instruction DIR()
  If Dir(Chemin2 & sDos, vbDirectory) = "" Then
    ' Dir ne renvoit rien, le dossier n'existe pas, il faut le Créer
    MkDir Chemin2 & sDos
  End If
  ' Vérifier si le dossier existe
  For Semaine = 1 To 52
    Cells(1, 9) = Semaine
    Equipe = Cells(1, 1).Value
    ' Empècher l'affichage d'alerte
    Application.DisplayAlerts = False
    fName2 = "EM " & Equipe & " - S " & Format(Semaine, "00") & ".xls"


    'Protection de la feuille
    Sheets("Séjours à coder").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
                      , AllowInsertingRows:=True, AllowDeletingRows:=True, AllowSorting:=True, _
                        AllowFiltering:=True, Password:="mdp@31"


    ActiveWorkbook.SaveAs Chemin2 & sDos & "\" & fName2
  Next Semaine
  ' Ré-activer les messages d'alerte
  Application.DisplayAlerts = True
End Sub

ActiveWorkbook.SaveAs Chemin2 & sDos & "\" & fName2

ActiveWorkbook.SaveAs "C:\Documents and Settings\PRAT.M\Mes documents\Fichier hebdo\2013\68EM 68 - S (n° de la semaine).xls"