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

Le
Françoise
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:úlse, 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 !
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
FFO
Le #18596581
Salut Françoise

Difficile de te répondre sans avoir ton fichier
cependant il y a dans le code que tu nous présentes à mon sens quelque chose
de pas trés logique dans cette partie :

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


La première partie :

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

Analyse la présence de la feuille "Liste Articles Stock" et mets la variable
bFeuilleStock à True si confirmée

La 2° partie :

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

Si la variable bFeuilleStock est à False donc feuille "Liste Articles Stock"
absente la crée et aussi active la feuille "Produit Consommé" nécessaire à la
suite du code

Donc en résumé si la feuille "Liste Articles Stock" n'est pas présente elle
est créée et la feuille "Produit Consommé" est activée sinon rien est
effectué notament l'activation de la feuille "Produit Consommé"
Cette instruction ne manque t'elle dans cette 2° alternative ?????
Tout dépend de la feuille active au démarage du code
Il me semble que je mettrais malgrés tout la ligne :

Sheets("Produit Consommé").Select

Dans cette configuration ainsi :

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
Else
' On sélectionne la feuille
Sheets("Produit Consommé").Select
Range("A16").Select

End If

Peut être là ton souci ?????

Vérifies et dis moi !!!!!
Françoise
Le #18597041
Bonjour FFO,

A force de chercher, j'ai enfin compris ce que je faisais mal : mes données
n'avaient rien à voir avec la structure article, j'ai donc modifié comme suit
:
déclarations des variables :
================== Dim Nrcde As String
Dim Client As String
Dim DateLivraison As String

puis destination des données :
====================== ' 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) = NrCde
Cells(i + 5, 6) = Client
Cells(i + 5, 7) = DateLivraison

Next
================================= Ca marche très bien maintenant
merci FFO de t'être penché sur mon problème
bonne journée à tous

"FFO" a écrit :

Salut Françoise

Difficile de te répondre sans avoir ton fichier
cependant il y a dans le code que tu nous présentes à mon sens quelque chose
de pas trés logique dans cette partie :

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


La première partie :

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

Analyse la présence de la feuille "Liste Articles Stock" et mets la variable
bFeuilleStock à True si confirmée

La 2° partie :

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

Si la variable bFeuilleStock est à False donc feuille "Liste Articles Stock"
absente la crée et aussi active la feuille "Produit Consommé" nécessaire à la
suite du code

Donc en résumé si la feuille "Liste Articles Stock" n'est pas présente elle
est créée et la feuille "Produit Consommé" est activée sinon rien est
effectué notament l'activation de la feuille "Produit Consommé"
Cette instruction ne manque t'elle dans cette 2° alternative ?????
Tout dépend de la feuille active au démarage du code
Il me semble que je mettrais malgrés tout la ligne :

Sheets("Produit Consommé").Select

Dans cette configuration ainsi :

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
Else
' On sélectionne la feuille
Sheets("Produit Consommé").Select
Range("A16").Select

End If

Peut être là ton souci ?????

Vérifies et dis moi !!!!!



Publicité
Poster une réponse
Anonyme