XL 2010 Additionner des nombres jusqu'à atteindre une certaine valeur

[PhilippeCam]

Bonjour à tous,

J'ai effectué des recherches sur le Forum, mais n'ai pas trouvé de réponse à mon problème.
Je cherche un moyen automatisé de trier une liste de valeur de manière à obtenir une somme approchant une valeur cible, et répéter l'opération jusqu'à la fin de la liste de valeurs.
Je joins un fichier pour illustrer ma demande, je n'arrive en effet pas à bien expliciter ma demande.

Mercis d'avance pour votre aide

 

[job75]

Juste un détail, A1 est exclue du calcul

Bien sûr puisque j'ai mis des en-têtes aux 4 colonnes.

Bonne nuit.

 

[PhilippeCam]

Voici la macro que vous attendez :

Sub Calcul()
Dim Lbarre, P As Range, nlig&, lig&, nbarre&, c As Range, i&
Lbarre = 6000
Set P = [A1].CurrentRegion
nlig = P.Rows.Count
Application.ScreenUpdating = False
P.Offset(1, 1).ClearContents
P.Offset(1, 1).Interior.ColorIndex = xlNone
lig = 2
1 If P(lig, 1) > Lbarre Then P(lig, 1).Select: MsgBox "Découpe erronée !", 48: Exit Sub
nbarre = nbarre + 1
P(lig, 2) = nbarre
P(lig, 3) = Lbarre '1ère barre
Set c = P(lig, 4)
c = Lbarre - P(lig, 1)
For i = lig + 1 To nlig
    If P(i, 1) < c And P(i, 2) = "" Then
        P(i, 2) = nbarre
        P(i, 4) = c - P(i, 1)
        Set c = P(i, 4)
    End If
Next i
c.Interior.ColorIndex = 6 'jaune
For i = lig + 1 To nlig
    If P(i, 2) = "" Then
        lig = i
        GoTo 1
    End If
Next i
End Sub

Dans le fichier joint elle est affectée au bouton.

Chapeau bas, Job75...
C'est exactement la routine que je cherchais.
Merci mille fois.
@Gégé-45550 c'est normal que ça ne prenne pas en compte la première ligne, la routine débute à la ligne 2, la ligne 1 étant la ligne de titre.
Je mets le sujet Résolu.