Mise à jour automatique d'un tableau

**Soifranc** · 13/04/2011, 23h36

Bonjour, merci pour votre aide.
Je voudrais remplir un tableau avec des données qui sont dans des onglets différents mais du même classeur.
1- Retrouver des information sur une ligne d'un onglet SOURCE en commencent par C5 ensuite D5 et ce jusqu'à la 1er cellule vide (arrêt de la boucle).
2- Quand le 1er repère est trouvé l'inscrire dans la 1er cellule vide de la zone Base sur l'onglet RENS en B11
3- Par rapport à ce 1er repère de l'onglet SOURCE chercher la valeur "x" qui se trouve dans la même colonne et qui correspond à l'article A ou B ou C et le coller en "D11" sur l'onglet RENS (à droite de la cellule B11). Coller également l'article A ou B ou C correspondant à la valeur "x" en C11.
4 - Recommencer à lire les infos sur la ligne repère de l'onglet SOURCE et le coller dans la 2ème cellule de la zone Base de l'onglet RENS, et ainsi de suite.
Nota : si la zone Base en complète insérer une nouvelle ligne dans le tableau.

**NEC14** · 14/04/2011, 09h40

Bonjour,

N'aurais-tu pas une ébauche de fichier car ta demande est un peu difficile à comprendre.
Merci

**Soifranc** · 14/04/2011, 13h23

voici une ébauche du tableau

**bellande** · 14/04/2011, 15h49

Bonjour,
Comme vous le présentez dans votre 1er post, il faut en effet écrire des boucles imbriquées qui vont parcourir les différents onglets et les différents tableaux. Je peux vous fournir demain le code qui réalise cela si vous complétez votre fichier excel en remplissant exactement la feuille de résultats d'après les données des 3 onglets que vous avez fournis. Cela afin de lever toute ambiguïté sur le besoin exprimé.
Bonne soirée

**Soifranc** · 14/04/2011, 16h20

Voici le tableau rempli. Merci d'avance

**bellande** · 15/04/2011, 11h58

Bonjour,
Voici un début de code à placer dans un bouton de commande sur la feuille RENS par exemple.
Il est possible de convenir que toutes les feuilles avant RENS contiennent les articles qui vont apparaitre dans le tableau de synthèse. Je peux faire de telle façon que le tableau est regénéré entièrement à chaque fois que l'on appui sur le bouton. De cette façon, on est certain que toutes les modifications de valeurs sont prises en compte. J'ai considéré qu'il n'y avait qu'une seule valeur de saisi pour un article donné.
J'attends vos instructions pour le terminer cet après midi si vous le souhaitez.
Cdlt
vp

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Private Sub CommandButtonRemplir_Click()
 
Const LIGNELETTRES = 5 ' A-D B-C se trouvent en ligne 5 actuellement
Const LIGNEGRILLAGE = 22 ' technique provisoire. En fait, il faudrait fabrique le tableau RENS en fonction des onglets qui se trouvent avant lui et non pas avoir un tableau déjà constitué
 
Dim FeuilleSource As Worksheet
Dim FeuilleRENS As Worksheet
Dim LigneSource As Integer
Dim ColonneSource As Integer
Dim LigneRENS As Integer
 
Set FeuilleSource = Worksheets(1)
Set FeuilleRENS = Worksheets("RENS")
 
ColonneSource = 3
LigneRENS = 5
 
Do
   ' on regarde si on trouve des lettres sur la ligne n°LIGNELETTRES
   If FeuilleSource.Cells(LIGNELETTRES, ColonneSource).Value <> "" Then
       LigneSource = LIGNELETTRES
       Do
          LigneSource = LigneSource + 1
       Loop Until FeuilleSource.Cells(LigneSource, ColonneSource).Value <> "" Or FeuilleSource.Cells(LigneSource, 1).Value = ""
       ' Si on a trouvé une valeur, on la sauvegarde dans la feuille RENS
       LigneRENS = LIGNEGRILLAGE
       Do
          LigneRENS = LigneRENS + 1
       Loop Until FeuilleRENS.Cells(LigneRENS, 2).Value = ""
 
       ' l'insertion de lignes n'est pas prise en compte ici mais
       ' est tout à fait réalisable
 
       ' mémorise Tronçon
       FeuilleRENS.Cells(LigneRENS, 2).Value = FeuilleSource.Cells(LIGNELETTRES, ColonneSource).Value
       ' mémorise type
       FeuilleRENS.Cells(LigneRENS, 3).Value = FeuilleSource.Cells(LigneSource, 1).Value
       ' mémorise Qté
       FeuilleRENS.Cells(LigneRENS, 4).Value = FeuilleSource.Cells(LigneSource, ColonneSource).Value
 
   End If
 
   ColonneSource = ColonneSource + 1
Loop Until FeuilleSource.Cells(LIGNELETTRES, ColonneSource).Value = ""
 
End Sub

**Soifranc** · 16/04/2011, 10h22

Ok c'est parfait.
Il n'y a qu'une seule quantité par référence de ligne et de code Article.
Mais aujourd'hui si j'augmente le nombre de référence mon tableau de s'agrandi pas. Est il possible d'envisager les 2 solutions (ou cela est trop compliqué):
1- Construire le tableau à chaque fois que l'on appui sur le bouton.
2- Remplir le tableau déjà construit et augmenter le nombre lignes nécessaire pour le renseigner complètement.
Merci d'avance

**bellande** · 18/04/2011, 14h16

Voici avec un peu de retard la nouvelle version qui efface à chaque fois la synthèse pour la recréer entièrement.
L'avantage est de garantir qu'il n'y a pas eu de saisie erronée dans la synthèse.

Pour que le programme fonctionne, il faut un premier petit bloc de cellules qui sert de modèle de présentation indentique à celui que vous avez fourni.

En A5 de chaque feuille Source, à la place du mot article, vous écrivez le libellé de base de l'article : filet, grillage ou autre.

Je reste à votre écoute en cas de besoin.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
Private Sub CommandButtonRemplir_Click()
 
Const LIGNELETTRES = 5 ' A-D B-C se trouvent en ligne 5 actuellement
Const LIGNE1ERARTICLE = 11 ' Position du 1er article sur la feuille RENS
Const NBLIGNESSUPPR = 1000 ' Nombre de lignes à supprimer avant le nouvel affichage
 
Dim FeuilleSource As Worksheet
Dim FeuilleRENS As Worksheet
Dim LigneSource As Integer
Dim ColonneSource As Integer
Dim LigneRENS As Integer
Dim NumFeuilleSource As Integer
 
Set FeuilleRENS = Worksheets("RENS")
 
' Effacer les anciennes lignes donc les anciens contenus en ne conservant que l'allure
' de la trame
LigneRENS = LIGNE1ERARTICLE
Do
   LigneRENS = LigneRENS + 1
Loop Until UCase(FeuilleRENS.Cells(LigneRENS, 2).Value) = "SOUS-TOTAL" Or UCase(FeuilleRENS.Cells(LigneRENS, 2).Value) = "SOUS TOTAL"
LigneRENS = LigneRENS + 1
Rows(LigneRENS & ":" & NBLIGNESSUPPR).Delete Shift:=xlUp   ' nombre de lignes à supprimer
FeuilleRENS.Range("A" & LIGNE1ERARTICLE).Value = ""
FeuilleRENS.Range("B" & LIGNE1ERARTICLE & ":D" & LigneRENS - 2).ClearContents
 
' On conserve juste la trame qui comportera 2 ligne vierges et le sous-total
If LigneRENS - LIGNE1ERARTICLE < 3 Then
  MsgBox "Il faut deux lignes avant le sous total, veuillez recréer la trame normale et relancer.", vbExclamation, "Problème de trame modifée"
  Exit Sub
End If
If LigneRENS - LIGNE1ERARTICLE > 3 Then
  FeuilleRENS.Rows(LIGNE1ERARTICLE + 2 & ":" & LigneRENS - 2).Delete Shift:=xlUp ' nombre de lignes à supprimer
End If
 
NumFeuilleSource = 1
LigneRENS = LIGNE1ERARTICLE
' Traitement d'une feuille SOURCE à chaque tour de boucle
Do
 
    Set FeuilleSource = Worksheets(NumFeuilleSource)
 
    ' On recopie cette trame en dessous pendant qu'elle est correcte
    FeuilleRENS.Rows(LigneRENS & ":" & LigneRENS + 2).Select
    Selection.Copy
    Range("A" & LigneRENS + 3).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
 
    ' On considère que l'on prend le nom générique du produit en A5
    FeuilleRENS.Cells(LigneRENS, 1).Value = FeuilleSource.Range("A5").Value
 
    ColonneSource = 3
    Do
       ' on regarde si on trouve des lettres sur la ligne n°LIGNELETTRES
       If FeuilleSource.Cells(LIGNELETTRES, ColonneSource).Value <> "" Then
           LigneSource = LIGNELETTRES
           Do
              LigneSource = LigneSource + 1
           Loop Until FeuilleSource.Cells(LigneSource, ColonneSource).Value <> "" Or FeuilleSource.Cells(LigneSource, 1).Value = ""
           ' Si on a trouvé une valeur, on la sauvegarde dans la feuille RENS
           LigneRENS = LIGNE1ERARTICLE - 1
           Do
              LigneRENS = LigneRENS + 1
           Loop Until FeuilleRENS.Cells(LigneRENS, 2).Value = ""
           Rows(LigneRENS + 1 & ":" & LigneRENS + 1).Insert Shift:=xlDown
           ' mémorise Tronçon
           FeuilleRENS.Cells(LigneRENS, 2).Value = FeuilleSource.Cells(LIGNELETTRES, ColonneSource).Value
           ' mémorise type
           FeuilleRENS.Cells(LigneRENS, 3).Value = FeuilleSource.Cells(LigneSource, 1).Value
           ' mémorise Qté
           FeuilleRENS.Cells(LigneRENS, 4).Value = FeuilleSource.Cells(LigneSource, ColonneSource).Value
       End If
       ColonneSource = ColonneSource + 1
    Loop Until FeuilleSource.Cells(LIGNELETTRES, ColonneSource).Value = ""
    Rows(LigneRENS + 1 & ":" & LigneRENS + 2).Delete Shift:=xlUp
 
    NumFeuilleSource = NumFeuilleSource + 1 ' traitement de la feuille suivante
    LigneRENS = LigneRENS + 2
 
Loop Until Worksheets(NumFeuilleSource).Name = "RENS" ' jusqu'à la feuille RENS (attention à l'orthographe)
Rows(LigneRENS & ":" & LigneRENS + 2).Delete Shift:=xlUp
 
Range("A1").Select
 
End Sub

**Soifranc** · 19/04/2011, 07h18

Ok, cela fonctionne bien. Merci
Mais j'ai modifié mon tableau, et je voulais savoir si il n'était pas
possible de faire des insertions de lignes plus tôt que de tout
reconstruire.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False

Merci beaucoup pour cette Aide

**bellande** · 19/04/2011, 08h58

La colonne Vanne semble indiquée qu'il s'agit d'une saisie manuelle à postériori. Si cette saisie est effectuée dans la synthèse, cela signifie qu'on ne peut plus effacer globalement le tableau et le reconstruire comme c'est le cas actuellement.
La notion d'insertion de ligne n'est pas un problème en soit, d'ailleurs il y en a déjà une dans le programme écrite de cette façon :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Rows(LigneRENS + 1 & ":" & LigneRENS + 1).Insert Shift:=xlDown

Le problème est le suivant : si vous modifiez vos tableaux sources de manière libre (ce qui est normal), vous êtes amené à modifier, ajouter, supprimer des valeurs de manière "anarchique" et donc le tableau de synthèse doit toujours être cohérent. La mise à jour ne se limite donc pas à des insertions de lignes.
Tout est possible cependant mais bien refaire le tour du cahier des charges avant.
A bientot

**Soifranc** · 21/04/2011, 07h34

Excusé moi pour cette modification du cahier des charges, c'est vrai la colonne VANNE est saisie manuellement.
Est il possible de mettre à jour le tableau automatiquement sans le reconstruire à chaque fois, et de laisser une ligne vierge avant chaque sous total. Si l'on conserve le tableau dans son intégralité peut-on masquer les Zone du tableau non utilisées ( avec Gestionnaire de noms ) et les réafficher pour la mise à jour.

Merci pour votre aide

**bellande** · 21/04/2011, 09h48

J'ai deux questions :

Sait-on déjà combien il y a de feuilles sources au maximum ?

Que signifie la remarque

Si l'on conserve le tableau dans son intégralité peut-on masquer les Zone du tableau non utilisées ( avec Gestionnaire de noms ) et les réafficher pour la mise à jour.

?

**Soifranc** · 21/04/2011, 13h42

Non, de plus toutes les feuilles ne sont pas concerné par la mise à jour. Se sont plus les articles qui gere la mise à jour du tableau.

Pour le tableau est il possible de le garder en entier et le faire évoluer à chaque mise à jour au lieu de le construire à chaque fois

**bellande** · 22/04/2011, 11h21

Oui, en théorie, il est possible de conserver le tableau de synthèse et seulement le mettre à jour.

Dans ce cas, comme je vous le disais dans un message précédent, il faut pouvoir mettre à jour une valeur qui a évolué. Par exemple si Filet Vert A-D a la valeur 25. Ensuite, si vous modifiez la valeur et que vous mettez 30 à la place de 25. Il faut que la feuille de synthèse indique désormais 30. Le problème est que si vous modifiez aussi le libellé "Filet Vert" en par exemple "Filet Vert clair" alors on ne peut plus savoir que "Filet Vert" correspond à "Filet Vert Clair".
L'intégrité des données n'est donc plus garanti.

C'est la même chose si vous modifiez "A-D" en "A-F"

Voila le soucis : comment faire ?

**Soifranc** · 22/04/2011, 14h01

Peut on faire une liaison avec le code article, car:.
le Filet Vert aura toujours la Réf: 12002 cela ne peut pas changer, de même pour les autres libellés d'article (chaque libellé d'article à sa Référence unique).
En revenche le repère A-D en C5 peut changer et ainsi de suite.

**bellande** · 22/04/2011, 15h51

Ok il faut ajouter une colonne pour la référence dans le tableau de synthèse.

Quand une valeur est supprimée d'une source, il faut aussi supprimer la ligne dans le tableau de synthèse.

La programmation est faisable malgré tout mais il faut la refaire entièrement.

Je pars une semaine en vacances mais je regarderai en rentrant si vous le souhaitez.

Bellande

**Soifranc** · 30/04/2011, 00h26

Pour moi la question n'est toujours pas résolue, et je veillerai à mettre résolu une fois le problème traité.
Merci d'avance

**bellande** · 30/04/2011, 11h48

Bonjour,
J'ai travailler 2 heures hier et ce matin sur votre demande pour refaire le programme.

Je suis un peu surpris et perplexe en lisant ce matin votre dernier message.
"La question n'est toujours pas résolue" ? : il s'agit d'un développement (bénévole) et non d'une simple question mais il semble que je ne vais pas assez vite.
Je pensais d'après votre avant dernier message que vous aviez compris que j'allais à nouveau revenir vers vous dès mon retour.

Voici donc le nouveau développement dans le fichier joint :

- Il me reste à traiter le cas où une valeur a été complètement effacée dans l'une des feuilles sources
- Ajouter la colonne du libellé de produit à coté de son code.
- Trouver éventuellement un autre endroit où placer la trame d'un produit ailleurs que dans la feuille RENS

Ce n'est pas de chance que la demande tombe au moment des vacances scolaires (acad. Nantes) et que je soit amené à m'absenter y compris à partir d'aujourd'hui jusqu'à jeudi. Je vous dis à jeudi si vous souhaitez que je termine.

Bellande

**Soifranc** · 06/05/2011, 16h00

Tout d'abord merci pour l'aide que vous m'apporté et excusez moi pour la réponse avec le message non résolu, mais je ne voulai blésser personne, mais faire une réponse au message reçu.

Nota: Je suis toujours interressé par une réponce pour résoudre le tableau

**bellande** · 09/05/2011, 08h43

Ok, pas de soucis

Voici une nouvelle version qui tente de prendre en compte toutes les possibilités de modification dans les tableaux sources (elles sont nombreuses).
La modification par erreur des valeurs de la feuille RENS a été prise en compte.

Tout d'abord, il faut se placer en colonne D et insérer une colonne dans l'ancienne version pour le libellé du produit (modification de la trame inscrite dans les 3 premières lignes).

Les libellés des colonnes (cellules jaunes) sont modifiables à volonté.

L'ancien programme doit être remplacé par celui-ci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
 
 
Option Explicit
 
Const LIGNELETTRES = 5 ' A-D B-C se trouvent en ligne 5 actuellement
Const LIGNE1ERARTICLE = 11 ' Position du 1er article sur la feuille RENS
Const NBLIGNESSUPPR = 1000 ' Nombre de lignes à supprimer avant le nouvel affichage
 
Private Sub CommandButtonRemplir_Click()
 
' Supprimer les produits qui ont disparus (éventuellement renommés)
SupprimerProduitsObsoletes
' Ajouter les nouveaux produits ou ceux qui ont changé de nom (dans ce dernier cas, l'ancien nom a été supprimé avant)
AjouterProduitsNouveaux
'' Mettre à jour les quantités correspondant aux codes utilisés
MettreAJour
'' Supprimer les références qui n'ont plus de valeur
SupprimerReferences
 
 
Range("A1").Select
 
End Sub
 
Public Function ChercherCode(ByVal NumLigne As Integer, ByVal NumFeuilleSource As Integer) As String
 Dim FeuilleSource As Worksheet
 Dim Colonne As Integer
 
 Set FeuilleSource = Worksheets(NumFeuilleSource)
 Colonne = 1
 Do
   Colonne = Colonne + 1
 Loop Until UCase(FeuilleSource.Cells(LIGNELETTRES, Colonne).Value) = "CODE" Or Colonne = 255
 If Colonne = 255 Then
   MsgBox "La dernière colonne du tableau SOURCE doit posséder le libellé CODE", vbCritical, "Erreur"
   End
 Else
   ChercherCode = FeuilleSource.Cells(NumLigne, Colonne).Value
 End If
End Function
 
Public Sub SupprimerProduitsObsoletes()
 
Dim FeuilleRENS As Worksheet
Dim LigneRens As Integer
Dim NumFeuilleSource As Integer
 
Set FeuilleRENS = Worksheets("RENS")
 
LigneRens = LIGNE1ERARTICLE
Do
   If FeuilleRENS.Range("A" & LigneRens).Value <> "" Then
      If Not RetrouverArticle(LigneRens) Then
         Do
             FeuilleRENS.Rows(LigneRens & ":" & LigneRens).Delete Shift:=xlUp
         Loop Until FeuilleRENS.Range("A" & LigneRens).Value <> "" Or FeuilleRENS.Range("B" & LigneRens).Value = ""
      Else
         LigneRens = LigneRens + 1
      End If
   Else
      LigneRens = LigneRens + 1
   End If
Loop Until FeuilleRENS.Range("B" & LigneRens).Value = ""
 
 
End Sub
 
 
Public Function RetrouverArticle(ByVal LigneRens As Integer) As Boolean
 
Dim NumFeuilleSource As Integer
Dim FeuilleRENS As Worksheet
Dim FeuilleSource As Worksheet
 
Dim Bool_Trouve As Boolean
 
NumFeuilleSource = 1
Set FeuilleRENS = Worksheets("RENS")
 
Bool_Trouve = False
Do
    Set FeuilleSource = Worksheets(NumFeuilleSource)
    ' On considère que l'on prend le nom générique du produit en A5
    If UCase(FeuilleRENS.Range("A" & LigneRens).Value) = UCase(FeuilleSource.Range("A" & LIGNELETTRES).Value) Then
       Bool_Trouve = True
    End If
    NumFeuilleSource = NumFeuilleSource + 1 ' traitement de la feuille suivante
Loop Until Worksheets(NumFeuilleSource).Name = "RENS" Or Bool_Trouve = True ' jusqu'à la feuille RENS (attention à l'orthographe)
 
RetrouverArticle = Bool_Trouve
 
End Function
 
Public Sub AjouterProduitsNouveaux()
Dim NumFeuilleSource As Integer
Dim FeuilleSource As Worksheet
Dim FeuilleRENS As Worksheet
Dim LigneRens As Integer
 
NumFeuilleSource = 1
Set FeuilleRENS = Worksheets("RENS")
 
 
Do
    Set FeuilleSource = Worksheets(NumFeuilleSource)
    ' on cherche le produit de la feuille source sur toutes les lignes de la feuille RENS
    LigneRens = LIGNE1ERARTICLE - 1
    Do
          LigneRens = LigneRens + 1
    Loop Until UCase(FeuilleRENS.Range("A" & LigneRens).Value) = UCase(FeuilleSource.Range("A" & LIGNELETTRES).Value) Or FeuilleRENS.Range("B" & LigneRens).Value = ""
 
    If UCase(FeuilleRENS.Range("A" & LigneRens).Value) <> UCase(FeuilleSource.Range("A" & LIGNELETTRES).Value) Then
       ' nouveau produit
       ' On recopie la trame
        FeuilleRENS.Rows("1:3").Select
        Selection.Copy
        Range("A" & LigneRens).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        FeuilleRENS.Range("A" & LigneRens).Value = FeuilleSource.Range("A" & LIGNELETTRES).Value
    End If
    NumFeuilleSource = NumFeuilleSource + 1 ' traitement de la feuille suivante
Loop Until Worksheets(NumFeuilleSource).Name = "RENS"  ' jusqu'à la feuille RENS (attention à l'orthographe)
 
 
End Sub
 
Public Sub MettreAJour()
Dim FeuilleSource As Worksheet
Dim FeuilleRENS As Worksheet
Dim LigneSource As Integer
Dim ColonneSource As Integer
Dim LigneRens As Integer
Dim NumFeuilleSource As Integer
Dim CodeProduit As String
Dim Produit As String
Dim RangeTrouve As Range
Dim LigneDebutProduit As Integer
Dim LigneFinProduit As Integer
 
 
 
Set FeuilleRENS = Worksheets("RENS")
NumFeuilleSource = 1
' Traitement d'une feuille SOURCE à chaque tour de boucle
Do
 
    Set FeuilleSource = Worksheets(NumFeuilleSource)
    ColonneSource = 3
    Do
       ' on regarde si on trouve des lettres sur la ligne n°LIGNELETTRES
       If FeuilleSource.Cells(LIGNELETTRES, ColonneSource).Value <> "" Then
           LigneSource = LIGNELETTRES
           Do
              LigneSource = LigneSource + 1
           Loop Until FeuilleSource.Cells(LigneSource, ColonneSource).Value <> "" Or FeuilleSource.Cells(LigneSource, 1).Value = ""
           ' Si on a trouvé une valeur, on la sauvegarde dans la feuille RENS
 
           CodeProduit = ChercherCode(LigneSource, NumFeuilleSource)
           If CodeProduit <> "" Then
              Set RangeTrouve = FeuilleRENS.Columns(3).Cells.Find(what:=CodeProduit, LookAt:=xlWhole)
              If Not (RangeTrouve Is Nothing) Then
                  ' le code existe déjà
                  ' mémorise Tronçon qui a éventuellement changé
                  RangeTrouve.Offset(0, -1).Value = FeuilleSource.Cells(LIGNELETTRES, ColonneSource).Value
                  ' mémorise référence du produit
                  RangeTrouve.Offset(0, 1).Value = FeuilleSource.Cells(LigneSource, 1).Value
                  ' mémorise Qté
                  RangeTrouve.Offset(0, 2).Value = FeuilleSource.Cells(LigneSource, ColonneSource).Value
                  If Left(RangeTrouve.Offset(0, 3).Value, 1) <> "¤" Then
                     RangeTrouve.Offset(0, 3).Value = "¤" + RangeTrouve.Offset(0, 3).Value
                  End If
              Else
                  ' le code est nouveau
                  Produit = FeuilleSource.Range("A" & LIGNELETTRES).Value
                  Set RangeTrouve = FeuilleRENS.Columns(1).Cells.Find(what:=Produit, LookAt:=xlWhole)
 
                  ' Le produit qui correspond à la nouvelle référence se trouve sur une ligne libre
                  If FeuilleRENS.Range("C" & RangeTrouve.Row).Value = "" Then
                     LigneRens = RangeTrouve.Row
                  ' ou bien la ligne suivante est libre
                  ElseIf FeuilleRENS.Range("C" & RangeTrouve.Row + 1).Value = "" And FeuilleRENS.Range("E" & RangeTrouve.Row + 1).Value = "" Then
                     LigneRens = RangeTrouve.Row + 1
                  Else
                  ' ou bien il faut créer une nouvelle ligne
                     LigneRens = RangeTrouve.Row + 1
                     Rows(RangeTrouve.Row + 1 & ":" & RangeTrouve.Row + 1).Insert Shift:=xlDown
 
                     ' Si l'insertion a lieu sur la ligne de sous-total alors il faut refaire la formule
                     If UCase(FeuilleRENS.Range("B" & LigneRens).Value) <> "SOUS TOTAL" And UCase(FeuilleRENS.Range("B" & LigneRens).Value) <> "SOUS-TOTAL" Then
                       FeuilleRENS.Range("E" & LigneRens + 1).Formula = "=SUM(E" & LigneRens - 1 & ":E" & LigneRens & ")"
                     End If
 
                  End If
                  ' mémorise Tronçon
                  FeuilleRENS.Range("B" & LigneRens).Value = FeuilleSource.Cells(LIGNELETTRES, ColonneSource).Value
                  ' mémorise code produit
                  FeuilleRENS.Range("C" & LigneRens).Value = CodeProduit
                  ' mémorise référence du produit
                  FeuilleRENS.Range("D" & LigneRens).Value = FeuilleSource.Cells(LigneSource, 1).Value
                  ' mémorise Qté
                  FeuilleRENS.Range("E" & LigneRens).Value = FeuilleSource.Cells(LigneSource, ColonneSource).Value
                  If FeuilleRENS.Range("F" & LigneRens).Value <> "¤" Then
                     FeuilleRENS.Range("F" & LigneRens).Value = "¤" + FeuilleRENS.Range("F" & LigneRens).Value
                  End If
              End If
            End If
       End If
       ColonneSource = ColonneSource + 1
    Loop Until FeuilleSource.Cells(LIGNELETTRES, ColonneSource).Value = ""
 
    NumFeuilleSource = NumFeuilleSource + 1 ' traitement de la feuille suivante
    LigneRens = LigneRens + 2
 
Loop Until Worksheets(NumFeuilleSource).Name = "RENS" ' jusqu'à la feuille RENS (attention à l'orthographe)
 
End Sub
 
 
 
Public Sub SupprimerReferences()
Dim FeuilleRENS As Worksheet
Dim LigneRens As Integer
Dim NomProduit As String
 
Set FeuilleRENS = Worksheets("RENS")
LigneRens = LIGNE1ERARTICLE
While FeuilleRENS.Range("B" & LigneRens).Value <> ""
 
   If Left(FeuilleRENS.Range("F" & LigneRens).Value, 1) <> "¤" Then
     If UCase(FeuilleRENS.Range("B" & LigneRens).Value) <> "SOUS TOTAL" And UCase(FeuilleRENS.Range("B" & LigneRens).Value) <> "SOUS-TOTAL" Then
        ' il faut supprimer la ligne mais en prenant des précautions
        NomProduit = FeuilleRENS.Range("A" & LigneRens).Value
        FeuilleRENS.Rows(LigneRens & ":" & LigneRens).Delete Shift:=xlUp
        If NomProduit <> "" Then
           If UCase(FeuilleRENS.Range("B" & LigneRens).Value) <> "SOUS TOTAL" And UCase(FeuilleRENS.Range("B" & LigneRens).Value) <> "SOUS-TOTAL" Then
               FeuilleRENS.Range("A" & LigneRens).Value = NomProduit
           Else
               FeuilleRENS.Rows(LigneRens & ":" & LigneRens).Delete Shift:=xlUp
           End If
        End If
        LigneRens = LigneRens - 1
     End If
   Else
     FeuilleRENS.Range("F" & LigneRens).Value = Right(FeuilleRENS.Range("F" & LigneRens).Value, Len(FeuilleRENS.Range("F" & LigneRens).Value) - 1)
   End If
 
   LigneRens = LigneRens + 1
Wend
 
 
End Sub

Mise à jour automatique d'un tableau [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager