VBA Récupérer sur chaque ligne la valeur d'une cell d'une autre fe

Bonjour,

j'ai une macro qui récapitule la liste des articles pris sur stock et les
totalise dans une autre feuille appelée Liste Articles Stock
je veux sur chaque ligne du récap de cette feuille indiquer :
le nom du client
le numéro de commande
la date de livraison
ces données figurent dans une autre feuille "Produits Consommé"
dans les cellules suivantes :
le nom du client en D5
le numéro de commande en D4
la date de livraison en D13

je n'y arrive pas !
=================
voici le code de la macro :
===
Option Explicit

Type Art
CodeArticle As String
RefArticle As String
Description As String
Qte As Double
NrCde As String
Client As String
DateLivraison As String


End Type

Dim StructArt() As Art
Dim IndiceStructArt As Integer
Sub ListeArticlesStock()
'

Dim rg, rg2 As Range
Dim CodeArt As String
Dim DescArt As String
Dim RefArt As String
Dim Qte As Double
Dim i As Integer
Dim IndiceEnCours As Integer
Dim Feuille As Worksheet
Dim bFeuilleStock As Boolean
Dim Client As String
Dim NrCde As String
Dim DateLivraison As String


IndiceStructArt = 0

bFeuilleStock = False
' On test la présence de la feuille de nom Articles Stock
For Each Feuille In ActiveWorkbook.Sheets
If Feuille.Name = "Liste Articles Stock" Then
bFeuilleStock = True
End If
Next Feuille

If bFeuilleStock = False Then
' la feuille Articles Stock n'existe pas
' On va la créer
ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Liste Articles Stock"
' On sélectionne la feuille
Sheets("Produit Consommé").Select
Range("A16").Select

End If

' On delete les infos de la feuille 3
Sheets("Liste Articles Stock").Cells.ClearContents


'On recherche le début
Set rg2 = Cells.Find(What:="REFERENCE", LookIn:=xlValues)
If Not rg2 Is Nothing Then
' On a trouvé la chaine de caractères

' On recherche la fin
Set rg = Cells.Find(What:="TOTAL COMMANDE", LookIn:=xlValues)
If Not rg Is Nothing Then
' On a trouvé la chaine de caractères

'On recherche le nom du client
'Set Client = Sheets("Produit Consommé").Range("D5")
'On recherche le Nr de commande
'Set NrCde = Sheets("Produit Consommé").Range("D4")
'On recherche la date de tir
'Set DateTir = Sheets("Produit Consommé").Range("D13")

' On traite toutes les cellules
For i = rg2.Row + 1 To rg.Row - 1
' On récupère le code article
CodeArt = Cells(i, rg2.Column)
If CodeArt <> "A" And CodeArt <> "B" And CodeArt <> "AC" And
CodeArt <> "BC" And CodeArt <> "-" Then
' On récupère la référence article
RefArt = Cells(i, rg2.Column + 1)
' On récupère la description
DescArt = Cells(i, rg2.Column + 2)
' On récupère la quantité
Qte = Cells(i, rg2.Column + 3)
' On récupère le nr de commande
NrCde = Sheets("Produit Consommé").Range("D4")
' On récupère le nom du Client
Client = Sheets("Produit Consommé").Range("D5")
' On récupère la date de livraison
DateLivraison = Sheets("Produit Consommé").Range("D13")
' On regarde si il existe dans la structure
IndiceEnCours = RechercheArt(RefArt)
If (IndiceEnCours <> 9999) Then
' si il existe déjà, on met à jour la quantité
' On l'ajoute
StructArt(IndiceEnCours).Qte =
StructArt(IndiceEnCours).Qte + Qte
Else
' Si il n'existe pas, on le créé
ReDim Preserve StructArt(IndiceStructArt + 1)
StructArt(IndiceStructArt).CodeArticle = CodeArt
StructArt(IndiceStructArt).RefArticle = RefArt
StructArt(IndiceStructArt).Description = DescArt
StructArt(IndiceStructArt).Qte = Qte
StructArt(IndiceStructArt).Client
StructArt(IndiceStructArt).NrCde
StructArt(IndiceStructArt).DateLivraison
IndiceStructArt = IndiceStructArt + 1
End If
End If
Next

' On ouvre une feuille XL de sortie (LISTE)
Sheets("Liste Articles Stock").Select
' On écrit le récapitulatif
For i = 0 To IndiceStructArt - 1
Cells(i + 5, 2) = StructArt(i).CodeArticle
Cells(i + 5, 1) = StructArt(i).RefArticle
Cells(i + 5, 3) = StructArt(i).Description
Cells(i + 5, 4) = StructArt(i).Qte
Cells(i + 5, 5) = StructArt(i).NrCde
Cells(i + 5, 6) = StructArt(i).Client
Cells(i + 5, 7) = StructArt(i).DateLivraison

Next

' On trie par ordre alphabétique les articles
Cells.Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("B1").Select


Else
' On a pas trouvé de fin
MsgBox "La phrase suivante indiquant la fin n'a pas été trouvée
: TOTAL COMMANDE"
End If
Else
' On a pas trouvé de début
MsgBox "Le mot ((REFERENCE)) indiquant le début de la recherche n'a
pas été trouvé"
End If

Columns("C:C").EntireColumn.AutoFit

MiseEnPageLISTE


End Sub

Function RechercheArt(RefArt As String)

Dim i As Integer

If IndiceStructArt = 0 Then
RechercheArt = 9999
GoTo Fin
End If

For i = 0 To IndiceStructArt - 1
' On recherche le code
If StructArt(i).RefArticle = RefArt Then
RechercheArt = i
GoTo Fin
Else
RechercheArt = 9999
End If
Next

Fin:

End Function

=======================================================

OU EST L'ERREUR ????

D'avance merci !