Sub Cal()

'* Déclaration des variables
Dim Anno, i, J, Mezo As Integer
Dim Année, Mois, T, d, m As Integer
Dim Lg&, y&, x&
 
 
Année = Year(Sheets("Menu").Range("H11"))
Mois = Month(Sheets("Menu").Range("H11"))


  '* Boucle de création des mois
  For Mezo = 1 To 4
    
    '* Ajout d'une feuille après la dernière feuille
    Sheets.Add after:=Worksheets(Worksheets.Count)
    
    '* Routine pour créer les feuilles du calendrier mensuel
    '* Désactivation de l'affichage de la grille
    ActiveWindow.DisplayGridlines = False
  
    '* Création du mois
    With ActiveSheet.Range("A1")
       ThisWorkbook.Worksheets("modele").Copy ActiveSheet
    
       '* La nouvelle feuille est nommée
       ActiveSheet.Name = MonthName(Mois)
    End With
    
    '* Insertion du nom du mois
    With ActiveSheet.Range("L1")
       .Value = UCase(MonthName(Mois) & " " & Année)
    End With
    
    Set Plage = Range([A13], Cells(Rows.Count, 1).End(xlUp))
    Plage.Offset(, 17).FormulaR1C1 = "=INT(MOD(INT((C3-2)/7)+0.6,52+5/28))+1"  '"=Year(RC1)"'
    Columns(17).NumberFormat = "00"

     
       
     '* Insérer une ligne de sous total après celle de "Dimanche"
    For d = [A80].End(xlUp).Row To 13 Step -1
    If Left(Cells(d, 1), 10) = "Dimanche" Then Cells(d + 1, 1).EntireRow.Insert

    If Cells(d, 1) <> "" And Cells(d + 1, 1).Value = "" Then Cells(d + 1, 1).Value = "Total Hebdo"
'    If Cells(d, 1) <> Cells(d + 1, 1) And Cells(d + 1, 1).Value = "" Then Cells(d + 1, 1).Value = "Total Hebdo"
    
    Next d
 

    
    Application.ScreenUpdating = False
    Lg = Range("A80").End(xlUp).Row
    For y = 13 To Lg
    x = y
  
    If Cells(y + 1, 17) = Cells(y, 17) Then
       Do While Cells(x + 1, 17) = Cells(y, 17)
          x = x + 1
       Loop
            
'        J 'ai essayé ces deux formules sans grand succès

       If Cells(x, 1).Value = "Total Hebdo" Then Cells(x, 6).FormulaR1C1 = "=IF(R[0]C2="""","""",IF(WEEKDAY(R[-1]C2)=7,SUM(F" & y & ":F" & x & "),""""))"
       If Cells(x, 1).Value = "Total Hebdo" Then Cells(x, 7).FormulaR1C1 = "=IF(R[0]C2="""","""",IF(WEEKDAY(R[-1]C2)=7,SUM(G" & y & ":G" & x & "),""""))"
       If Cells(x, 1).Value = "Total Hebdo" Then Cells(x, 9).FormulaR1C1 = "=IF(R[0]C2="""","""",IF(R[1]C[-3]<R[0]C[-2],SUM(R[-7]C:RC),IF(R[0]C[-3]=R[0]C[-2],0,IF((INT(R[0]C[-3])*24+(R[0]C[-3]-INT(R[0]C[-3]))*24)<51.75,((INT(R[0]C[-3])*24+(R[0]C[-3]-INT(R[0]C[-3]))*24)-(INT(R[0]C[-2])*24+(R[0]C[-2]-INT(R[0]C[-2]))*24))/24,IF((INT(R[0]C[-3])*24+(R[0]C[-3]-INT(R[0]C[-3]))*24)>51.75,(51.75/24)-R[0]C[-2])))))"
       If Cells(x, 1).Value = "Total Hebdo" Then Cells(x, 10).FormulaR1C1 = "=IF(R[0]C2="""","""",IF((INT(R[0]C[-4])*24+(R[0]C[-4]-INT(R[0]C[-4]))*24)>51.75,((INT(R[0]C[-4])*24+(R[0]C[-4]-INT(R[0]C[-4]))*24)-51.75)/24,0))"
       If Cells(x, 1).Value = "Total Hebdo" Then Cells(x, 11).FormulaR1C1 = "=IF(R[0]C2="""","""",IF(WEEKDAY(R[-1]C2)=7,SUM(INDIRECT(""K""&MAX(ROW()-7,12)&"":K""&ROW()-1)),""""))"
       If Cells(x, 1).Value = "Total Hebdo" Then Cells(x, 12).FormulaR1C1 = "=IF(R[0]C2="""","""",IF(WEEKDAY(R[-1]C2)=7,SUM(INDIRECT(""L""&MAX(ROW()-7,12)&"":L""&ROW()-1)),""""))"
       If Cells(x, 1).Value = "Total Hebdo" Then Cells(x, 13).FormulaR1C1 = "=IF(R[0]C2="""","""",IF(WEEKDAY(R[-1]C2)=7,SUM(INDIRECT(""M""&MAX(ROW()-7,12)&"":M""&ROW()-1)),""""))"
       If Cells(x, 1).Value = "Total Hebdo" Then Cells(x, 14).FormulaR1C1 = "=IF(R[0]C2="""","""",IF(WEEKDAY(R[-1]C2)=7,SUM(INDIRECT(""N""&MAX(ROW()-7,12)&"":N""&ROW()-1)),""""))"
       If Cells(x, 1).Value = "Total Hebdo" Then Cells(x, 15).FormulaR1C1 = "=IF(R[0]C2="""","""",IF(WEEKDAY(R[-1]C2)=7,SUM(INDIRECT(""O""&MAX(ROW()-7,12)&"":O""&ROW()-1)),""""))"
       If Cells(x, 1).Value = "Total Hebdo" Then Cells(x, 16).FormulaR1C1 = "=IF(R[0]C2="""","""",IF(WEEKDAY(R[-1]C2)=7,SUM(INDIRECT(""P""&MAX(ROW()-7,12)&"":P""&ROW()-1)),""""))"

       y = x
    
    End If
        
    Next y
     

    '* Compteur pour incrémenter les mois et les Années
    ActiveSheet.[A1].Select
    Mois = Mois + 1
    If Mois = 13 Then
       Mois = 1
       Année = Année + 1
    End If
  Next
  
  '* Désactivation des messages d'Excel qui demande une confirmation
  '* lors de la suppression d'une feuille
  Application.DisplayAlerts = False
  
   '* Suppression des trois feuilles par défaut du classeur
   For Each Feuille In Sheets
     If Left(Feuille.Name, 5) = "Feuil" Then Feuille.Delete
   Next

   '* Supression du Bouton Création du Calendrier
'   ActiveWorkbook.Sheets("Menu").Select
'   ActiveSheet.Shapes.Range(Array("Bouton 13")).Select
'   Selection.Delete

  '* Réactivation des messages système d'Excel
  Application.DisplayAlerts = True
  
  '* Sélection de la première feuille
'  ActiveWorkbook.Sheets("novembre").Select
'  [A1].Select
End Sub