1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
|
Sub Cumul()
Dim wsh2 As Worksheet, C As Range, derligne As Long
Dim lmois As Long, lparc As Integer, total As Long, B As Integer
Set wsh2 = Worksheets("Feuil2")'le nom de la feuille ou tu écris
lmois = 13 'ligne ou est la ligne des mois
lparc = 14 '1er ligne des valeurs a totaliser
With Worksheets("Feuil1")'le nom de la feuille à totaliser
Do While .Cells(lparc, 1) <> ""
total = 0
For B = 3 To 14
If DatePart("m", .Cells(lmois, B)) < DatePart("m", .Cells(1, 5)) Then
If .Cells(lparc, B) <> "" Then total = total + .Cells(lparc, B)
End If
Next
'parcours dans feuil2 la ligne des mois
derligne = wsh2.Cells(Rows.Count, 1).End(xlUp).Row
For B = 2 To 14
'si le mois actuel est trouvé dans la deuxième feuille
If DatePart("m", .Cells(1, 5)) = DatePart("m", wsh2.Cells(1, B)) Then
'vérifier si l'agence existe déja
Set C = wsh2.Range("A2:A" & derligne).Find(.Cells(lparc, 1), LookIn:=xlValues, lookat:=xlWhole)
If Not C Is Nothing Then
'si oui on écrit la valeur dans la ligne correspondante
wsh2.Cells(C.Row, B) = total
Exit For
Else
'sinon on écrit le nom de l'agence en plus
wsh2.Cells(derligne + 1, 1) = .Cells(lparc, 1)
wsh2.Cells(derligne + 1, B) = total
Exit For
End If
End If
Next
lparc = lparc + 1
Loop
End With
End Sub |
Partager