Private Sub Calcul()
Dim i As Integer, l As Integer, c As Integer, n As Integer, test As Integer
Dim noms(7) As String
Dim repas(7, 12) As Integer
Dim heures(7, 12) As Single
For i = 2 To Worksheets.Count
Sheets(i).Select 'sélection première semaine
l = 8 'première ligne
c = 8 'première colonne
n = 1 'premier nom
Do
'Si première feuille on mémorise le nom
If (i = 2) Then
If c = 8 Then
noms(n) = Cells(l - 4, 2)
Else
noms(n) = Cells(l - 3, c - 5)
End If
End If
For k = l To l + 4
If Cells(k, c) > 0 Then
test = Month(Cells(k, 1))
repas(n, Month(Cells(k, 1))) = repas(n, Month(Cells(k, 1))) + Cells(k, c)
End If
If c = 8 Then H = Cells(k, c - 2) Else H = Cells(k, c - 1)
heures(n, Month(Cells(k, 1))) = heures(n, Month(Cells(k, 1))) + H
Next k
n = n + 1
If c > 7 Then
l = l + 10
c = 7
Else
c = 15
End If
Loop Until l > 38
' Autres repas
noms(7) = "Autres repas"
For k = 46 To 49
If Cells(k, 16) > 0 Then
test = Month(Cells(k, 13))
repas(n - 1, Month(Cells(k, 13))) = repas(n - 1, Month(Cells(k, 13))) + Cells(k, 16)
End If
Next k
Next i 'Traitement semaine suivante
'Ecriture des résultats
Worksheets("Accueil").Select
For l = 3 To 8
For i = 1 To 6 'recherche équivalence du nom
If Cells(l, 1) = noms(i) Then
For k = 1 To 12
Cells(l, k + 1) = repas(i, k)
Cells(l + 10, k + 1) = heures(i, k)
Next k
Exit For
End If
Next i
Next l
'autres repas
For k = 1 To 12
Cells(9, k + 1) = repas(7, k)
Cells(19, k + 1) = heures(7, k)
Next k
End Sub