Macro VBA pour gestion de stock

Bonjour le Forum ,

Je sollicite votre aide vu ma très faible connaissance en VBA.

S'il vous plait, je voudrai réaliser une macro dans un bouton qui effectue le besoin suivant :

Les données qui m'intéressent du tableau :

• Transfert Date : La date de transfert du projet ( elle est sous forme de semaine , week)
• V1: volume V1
• V2 : volume V2

Prenons l'exemple d'un component X qui va etre transféré le Week4 .

Alors cette macro doit être capable d'aller chercher le mot Week4 dans la liste horizontale des Week, et quand trouver l'équivalence alors :

• Insérer dans la première cellule équivalente Week4 le volume V1 tel qu'il est (le copier coller)
• et puis pour le week qui suit : Week5 , on va insérer tjrs le V1 mais cette fois ci on ajoute V2/(semaines de l'année-5+1) i.e : V1+V2/(52-5+1) . N.B: 5 fait référence au Week5 ( la cellule juste en haut).
• Week6: V1+( V2/(52-6+1))

P.S : Le tableau est dynamique

Ci joint le fichier

Merci beaucoup

Bonjour et bonne année,

Ci-dessous une procédure à tester.

Cdlt.

Option Explicit

Sub Rectangleàcoinsarrondis1_Cliquer()
Dim ws As Worksheet
Dim lo As ListObject
Dim lWeek As Long
Dim dblV1 As Double, dblV2 As Double
Dim I As Long, J As Long
Dim k As Long

    Application.ScreenUpdating = False
    Set ws = ActiveSheet: Set lo = ws.ListObjects(1)

    With lo
        For I = 1 To .DataBodyRange.Rows.Count
            lWeek = .DataBodyRange.Cells(I, 4).Value
            dblV1 = .DataBodyRange.Cells(I, 19).Value
            dblV2 = .DataBodyRange.Cells(I, 20).Value
            k = 0
            For J = 21 To .ListColumns.Count
                If .HeaderRowRange.Cells(J).Value >= lWeek Then
                    Select Case k
                        Case 0
                            .DataBodyRange.Cells(I, J).Value = dblV1
                            k = 1
                        Case 1
                            .DataBodyRange.Cells(I, J).Value = _
                            dblV1 + dblV2 / (52 - .HeaderRowRange.Cells(J) + 1)
                    End Select
                Else
                    .DataBodyRange.Cells(I, J) = vbNullString
                End If
            Next J
        Next I
    End With

    Set lo = Nothing: Set ws = Nothing

End Sub

Merci énormémeeeeent Mr. Jean_Eric,

Une joie extra super parfaite en ce moment là.

Tout le respect est à vous

Bonne journée

Bonjour,

Merci pour tes remerciements.

Cdlt.