XL 2013 VBA et méthode PEPS/FIFO

Bonjour,

Alors voilà habituellement je m'en sors plutôt bien avec Excel mais là la méthode PEPS/FIFO a ut raison de moi et de mon endurance.

Malgré plusieurs tutoriels et plusieurs cours sur internet suivi je n'arrive pas a obtenir le résultat souhaité...

Je vais tenter d'être claire dans mon explication :
- Il s'agit de gérer un portefeuille de valeurs mobilières de placement
- Toutes les valeurs mobilières (entrées et sorties) doivent s'enregistrer sur une même feuille pour facilité le traitement par un tableau croisé dynamique par la suite

Pour le moment j'ai réussis en suivant divers tutoriels et cours a mettre en place la macro pour le traitement d'une seule valeur mobilière et je bloque sur le traitement du If qui pourrait m'aider a mettre en place pour plusieurs valeurs mobilières de placement

Et je ne me suis pas encore penchée sur le calcul de ma plus ou moins value

Voici mon code pour le moment :


Option Explicit

Sub FIFO()

'Déclaration des variables

Dim nblots As Double
Dim numlotasortir As Long
Dim qtélots(1 To 50000) As Integer
Dim numligne As Variant
Dim qté As Double
Dim qté2 As Double
Dim noVMP As String
Dim i As Integer
Dim nblignes As Integer
Dim Worksheet() As Object



'Entêtes tableau récapitulatif FIFO

Feuil2.Cells(1, 1).Value = "Banque"
Feuil2.Cells(1, 2).Value = "Nom VMP"
Feuil2.Cells(1, 3).Value = "Réf. VMP"
Feuil2.Cells(1, 4).Value = "N° Lot"
Feuil2.Cells(1, 5).Value = "Qté Entrée"
Feuil2.Cells(1, 6).Value = "Qté Sortie"
Feuil2.Cells(1, 7).Value = "Solde Qté"
Feuil2.Cells(1, 8).Value = "PU Achat"
Feuil2.Cells(1, 9).Value = "Val. Stock Final"

'Mise a zéro des valeurs

numligne = 1
nblots = 0
numlotasortir = 1
nblignes = WorksheetFunction.CountA(Range("D")) 'Fonction excel NBVAL dénombre le nombre de lignes renseignées dans la feuille 1

MsgBox nblignes 'vérification (a supprimer par la suite)

Do
For i = 2 To nblignes
noVMP = Feuil1.Cells(numligne, 4).Value

If Range("D" & i).Value = noVMP Then


Do
numligne = numligne + 1
qté = Feuil1.Cells(numligne, 5).Value


If qté > 0 Then
nblots = nblots + 1
qtélots(nblots) = qté

Feuil2.Cells(nblots + 1, 1).Value = "=Feuil1!B" & numligne
Feuil2.Cells(nblots + 1, 2).Value = "=Feuil1!C" & numligne
Feuil2.Cells(nblots + 1, 3).Value = "=Feuil1!D" & numligne
Feuil2.Cells(nblots + 1, 4).Value = "Lot N°" & nblots
Feuil2.Cells(nblots + 1, 5).Value = qté
Feuil2.Cells(nblots + 1, 6).Value = 0
Feuil2.Cells(nblots + 1, 7).FormulaLocal = "=somme(E" & nblots + 1 & ":F" & nblots + 1 & ")"
Feuil2.Cells(nblots + 1, 8).FormulaLocal = "=Feuil1!F" & numligne
Feuil2.Cells(nblots + 1, 9).FormulaLocal = "=G" & nblots + 1 & "*H" & nblots + 1

ElseIf qté <= 0 Then
qté2 = -qté


Do
If qté2 > qtélots(numlotasortir) Then
qté2 = qté2 - qtélots(numlotasortir)
Feuil2.Cells(numlotasortir + 1, 6).Value = Feuil2.Cells(numlotasortir + 1, 6).Value - qtélots(numlotasortir)
qtélots(numlotasortir) = 0
numlotasortir = numlotasortir + 1

Else: qtélots(numlotasortir) = qtélots(numlotasortir) - qté2
Feuil2.Cells(numlotasortir + 1, 6).Value = Feuil2.Cells(numlotasortir + 1, 6).Value - qté2
qté2 = 0

End If

Loop While qté2 > 0 And numlotasortir <= nblots

End If

Loop While qté <> 0

Else: numligne = numligne + 1

End If

Next i

Loop While qté <> 0


End Sub

J'ai mi en rouge les parties qui me posent problème pour le moment j'essai que mon fichier prenne en compte pour retirer des lots 2 variables mais pas moyen si quelqu'un peu me dire quel truc coince dans mon code ce serrait gentil.

Je joins le fichier en passant même si je sais pas si ca peut aider

Merci par avance