Scinder valeur et ajouter le restant

[Lucie61]

Bonjour Le Forum

Je n'ai pas réussi à trouver de discussion concernant mon problème. Je voudrais juste savoir si cela est possible de répartir le prorata de deux valeurs (contenue sur colonne C et D) sur une autre ligne qu'on insert en dessous en fonction d'une valeur maximum contenu sur une autre cellule W.

J'ai les valeurs de la colonne C qui font varier les valeurs de la colonne D ( car si C change, la cellule en D = colonne B x colonne C donc la valeur en D change(mais je n'ai pas mis de formule car à cette zone ce sont des extractions d'un système collée) et la combinaison des valeurs colonne C et D fait varier la colonne V.

J'aimerai
1- si colonne V supérieur à W
2- alors essayer de faire varier la valeur C vers un chiffre inférieur jusqu'à ce que la valeur en V soit inférieure à la valeur en W.
3- Une fois cette valeur changée ET colonne V inférieure à colonne W
4- alors insérer une ligne en dessous avec les mêmes données de cette ligne en A,B,E,
P à V qui ont des formules, les autres colonne F à K, j'ai dû enlever les formules et coller brute les données car ce sont des recherches V dans plusieurs onglets, et ces onglets sont confidentielles donc j'ai du supprimer)
6- Pour les valeurs en colonne C et D, juste faire le prorata de ce qui reste par rapport à la valeur initiale.
(exemple : si au départ, B = 200, C = 10, D = 2000, V = 2000, W = 1500 ==> V supérieur à W
résultat final :
Cette même ligne : B = 200, C = 7; D = 1400, V = 1400, W = 1500
Ligne insérée : B = 200, C = 3, D = 600, V = 600, W = 1500)
Les valeurs de la colonne V se modifient toutes seules via la formule que j'ai mise)

Espérant que vous avez compris mon besoin.

Sur le fichier, j'ai l'onglet Base de données, et onglet Résultat voulu (afin que vous puissiez voir ce que je souhaite)

Je remercie par avance pour votre aide précieuse.

Bonne journée à vous

Lucie61

 

[Rouge]

Bonjour,

Essayez ceci

Sub Scinder_Valeur()
    Dim Derlig As Long, i As Long
    Dim Val_C As Long, Val_D As Long
    Application.ScreenUpdating = False
    Derlig = Range("A" & Rows.Count).End(xlUp).Row
    For i = Derlig To 2 Step -1
        If Cells(i, "V") > Cells(i, "W") Then
            Val_C = Cells(i, "C")
            Val_D = Cells(i, "D")
            Do While Cells(i, "V") > Cells(i, "W")
                Cells(i, "C") = Cells(i, "C") - 1
            Loop
            Rows(i).Copy
            Rows(i + 1).Insert Shift:=xlDown
            Cells(i + 1, "C") = Val_C - Cells(i, "C")
            Cells(i + 1, "D") = Val_D - Cells(i, "D")
        End If
    Next i
End Sub

Cdlt