Utilisation successive du solver

1 pièce(s) jointe(s)

Bonsoir à tous,

J'aimerais lancer une macro qui utilise le solver plusieurs fois afin de trouver les valeurs des taux dont j'ai besoin. Le code que j'ai essayé fonctionne pour la première résolution du solver mais pour les autres, ça ne marche pas.
Code:

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 Sub Macro1() Dim C As Range Dim row As Integer, colum As Integer With Sheets("travaux2") Set plage_taux = Range(.[Q5], .[Q5].End(xlDown)).Offset(, 1) row = 22 colum = 3 For Each C In plage_taux cible = C.Offset(row, Column) valeur = C.Offset(, -12) SolverOk SetCell:="cible", MaxMinVal:=3, ValueOf:="valeur", ByChange:= _ "C" SolverSolve row = row - 1 Column = Column + 3 Next C End With End Sub
Pour la première cellule (C) il me trouve bien la valeur, il passe à la suivante, il me dit avoir résolu mais en fait il n'a rien fait.

Par ailleurs, quelqu'un saurait-il comment ne pas faire afficher la fenêtre de "résultat du solver", afin d'éviter de toujours avoir à appuyer sur ok pour passer à la prochaine résolution ?

Je laisse le fichier en PJ au cas où

Merci à tous,

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Macro1()
Dim Valeur As Double
Dim Cible As String
Dim j As Integer
Dim c As Range
 
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Travaux2")
    For Each c In .Range("R5:R25")
        If c.Offset(0, -1) = "" Then Exit For
        j = j + 3
        Cible = .Range("R27").Offset(0, j).Address
        Valeur = c.Offset(0, -12).Value
        SolverReset
        SolverOk SetCell:=Cible, MaxMinVal:=3, ValueOf:=Valeur, ByChange:=c.Address
        SolverSolve True
    Next c
End With
SolverReset
End Sub

Merci.