Discussion :

[jslpfasc2]

Salut à tous!

J'ai un petit soucis dans la construction d'une macro VBA, je vous explique mon problème.
Je voudrais constituer une BDD avec des infos présentes sur des factures.

Ces factures sont présentes dans un fichier XL les unes à la suite des autres dans chaque onglet.
Je voudrais donc créer une macro qui me copie les infos onglet après onglet, donc une boucle.

Au début de chaque boucle, je souhaiterais vérifier que la facture en cours de traitement par cette même boucle n'existe pas dans la BDD pour éviter les doublons.
Pour ça j'ai une référence pour chaque facture et je fais un petit check dans la première colonne de la BDD pour voir si elle y est.

Le but étant donc de dire à la macro:

Pour chaque classeur
Vérifier que la référence de la facture de l'onglet en cours n'est pas déjà dans la première colonne de la BDD.
SI elle y est ALORS on passe au classeur suivant
SINON on effectue le code ci dessous
(bla bla bla là y'a mon code de copie)

Donc voilà ce que j'ai codé :

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
Dim Ws As Worksheet
Dim oCell As Range
 
 
For Each Ws In ThisWorkbook.Worksheets
 
    For Each oCell In Workbooks("BDD.xlsx").Sheets("BDD").Range("A2:A1000000")
        If oCell.Value = ReferenceFacture.Value Then
        Exit For
        Next Ws
        Else
 
(... MON CODE DE COPIE DES CELLULES ...)
 
End If
Next Ws

Seulement il me mets l'erreur "Next sans for" en désignant le premier Next Ws...

Je suis bloqué, je pense que mes Next et If ne sont pas dans le bon sens mais je n'arrive pas à me dépatouiller.
Si l'un d'entre vous à sa petite idée je suis preneur!

Merci beaucoup à vous tous!

jsplfasc2

[casefayere]

Bonjour,
1ere chose

Code :

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

1
2
3
4
'....
 Exit For
        Next Ws
        Else

tu as "else" après le next donc ton message d'erreur est normal, le end if doit passer avant le next

2eme chose comment as_tu déclarer "ReferenceFacture" ?
3eme chose dans

Code :

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

Workbooks("BDD.xlsx").Sheets("BDD").Range("A2:A1000000")

BDD n'a pas de macros ? et plutôt que "A100000000" utilises le "Rows.count"

[Kimy_Ire]

Bonjour jslpfasc2,

Moi, je ferais plutôt ça comme ça :

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
Option Explicit
 
Sub Recup_Facture()
Dim Ws As Worksheet
Dim oCell As Range
 
'Pour chaque Feuille de mon classeur courant
For Each Ws In ThisWorkbook.Worksheets
    'Avec la feuille BDD de BDD.xlsx (d'ailleurs, cela devrait surement être .xlsm puisque ta macro devrait se trouver dedans)
    With Workbooks("BDD.xlsx").Sheets("BDD")
        'On fait un recherche de ReferenceFacture.Value (de Ws) dans toute la colonne 1
        Set oCell = .Columns(1).Find(Ws.ReferenceFacture.Value, LookIn:=xlValues, LookAt:=xlWhole)
        'au lieu de la colonne 1 on peut faire la recherche de A2 à la dernière ligne non-vide de la colonne 1 - ci-dessous, ca revient au même
        'Set oCell = Range(.Range("A2"), .Cells(.Rows.Count, 1).End(xlUp)).Find(Ws.ReferenceFacture.Value, LookIn:=xlValues, LookAt:=xlWhole)
 
        'si on ne trouve rien, cela signifie que ta référence n'est pas présente
        If oCell Is Nothing Then
            'et on peut écrire
        Else
            'cette partie Else n'est pas obligatoire
            'sinon, tu fais ce que tu veux.
        End If
 
        'Et on remet "rien"
        Set oCell = Nothing
    End With
Next Ws
 
End Sub

La fonction Find te permet d'aller beaucoup plus vite je pense.

Bref, n'hésite pas à revenir vers moi !

Cordialement,
Kimy

[jslpfasc2]

Bonjour à vous deux, merci pour vos réponses!

Casefayere, j'ai essayé de changer le next de place mais l'erreur reste la même...
Non ma macro est contenue dans un .xlam que j'ai associé à un bouton.
Je me place sur le classeur contenant les factures quand je lance le code!

Pour référence facture, dans ma facture c'est écrit "REFERENCE : 123456789". Or moi je veux récupérer seulement les chiffres donc j'ai écris :

Code :

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

Mid(Cells(3, 4).Value, 9, 30)

Du coup, ton code Kimy donne :

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
Option Explicit
 
Sub Recup_Facture()
Dim Ws As Worksheet
Dim oCell As Range
 
'Pour chaque Feuille de mon classeur courant
For Each Ws In ThisWorkbook.Worksheets
    'Avec la feuille BDD de BDD.xlsx (d'ailleurs, cela devrait surement être .xlsm puisque ta macro devrait se trouver dedans)
    With Workbooks("BDD.xlsx").Sheets("BDD")
        'On fait un recherche de ReferenceFacture.Value (de Ws) dans toute la colonne 1
        Set oCell = .Columns(1).Find(Ws.ReferenceFacture.Value, LookIn:=xlValues, LookAt:=xlWhole)
        'au lieu de la colonne 1 on peut faire la recherche de A2 à la dernière ligne non-vide de la colonne 1 - ci-dessous, ca revient au même
        'Set oCell = Range(.Range("A2"), .Cells(.Rows.Count, 1).End(xlUp)).Find(Mid(Ws.Cells(3, 4).Value, 9, 30), LookIn:=xlValues, LookAt:=xlWhole)
 
        'si on ne trouve rien, cela signifie que ta référence n'est pas présente
        If oCell Is Nothing Then
            'et on peut écrire
        Else
            'cette partie Else n'est pas obligatoire
            'sinon, tu fais ce que tu veux.
        End If
 
        'Et on remet "rien"
        Set oCell = Nothing
    End With
Next Ws
 
End Sub

si j'ai bien compris.

Malheureusement il ne me renvoie rien...
J'ai testé plusieurs manip', comme par exemple mettre "If Not ocell Is Nothing" à la place de "If ocell Is Nothing".

Là ça me remplis les deux premières lignes de la BDD mais avec deux fois les données du premier onglet des factures, et c'est tout... Etrange!

J'essaye de tester en simplifiant un max mais j'ai l'impression que la boucle des feuilles du classeur ne fonctionne pas, et qu'elle stagne à la première...

Pour info, voilà mon code complet :

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
Public col As Integer
Public line As Long
Public nb_colis As Integer
Public cell_test As String
 
 
Sub copie()
'Déclare la variable objet Worksheet
Dim Ws As Worksheet
Dim oCell As Range
 
 
 
For Each Ws In ThisWorkbook.Worksheets
 
With Workbooks("CRM.xlsx").Sheets("BDD")
'Set oCell = .Columns(1).Find(Mid(Ws.Cells(3, 4), 9, 30).Value, LookIn:=xlValues, LookAt:=xlWhole)
Set oCell = Range(.Range("A2"), .Cells(.Rows.Count, 1).End(xlUp)).Find(Mid(Ws.Cells(3, 4).Value, 9, 30), LookIn:=xlValues, LookAt:=xlWhole)
 
If Not oCell Is Nothing Then
 
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
 
''''COMPTAGE LIGNES''''
 
line = -1
Do
line = line + 1
cell_test = Workbooks("CRM.xlsx").Sheets("BDD").Cells(line + 1, 1)
Loop Until cell_test = ""
 
 
''''COMPTAGE DES LOTS''''
 
Range("A24").UnMerge
 
nb_colis = UBound(Split(Cells(24, 1), "LOT"))
 
Range("A24:E28").Merge
Range("A24").HorizontalAlignment = xlLeft
 
 
''''COPIE DES VALEURS DANS BDD''''
 
ActiveSheet.Select
 
Dim i As Integer
For i = 1 To nb_colis
 
 
'Reference Facture
 
Workbooks("CRM.xlsx").Sheets("BDD").Cells(line + i, 1) = Mid(Cells(3, 4), 9, 30)
 
'nb_colis
 
 
Workbooks("CRM.xlsx").Sheets("BDD").Cells(line + i, 2) = nb_colis
 
'civilite
'???
 
'nom
Workbooks("CRM.xlsx").Sheets("BDD").Cells(line + i, 4) = Cells(8, 3)
 
'No TVA
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 5) = Cells(18, 2)
 
'telephone
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 6) = Cells(17, 2)
 
'telephone2
'???
 
'mail1
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 8) = Cells(16, 2)
 
'mail2
'???
 
'adresse de facturation
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 10) = Cells(9, 3)
 
'codepostal
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 11) = Cells(10, 3)
 
'ville
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 12) = Cells(10, 4)
 
'pays
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 13) = Cells(11, 3)
 
'Date de vente
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 14) = Cells(22, 2)
 
'salle
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 15) = Cells(22, 4)
 
'CP/SVV
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 16) = Cells(21, 2)
 
'Typologie d objet
 
Dim a As Variant
Workbooks("BDD.xlsx").Sheets("BDD").Cells(2, 52) = Cells(24, 1).Value
 
a = Split(Workbooks("CRM.xlsx").Sheets("BDD").Cells(2, 52), Chr(10))
 
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 17) = a(i - 1)
Workbooks("BDD.xlsx").Sheets("BDD").Cells(2, 52).Delete
 
 
'montant bordereau
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 18) = Mid(Cells(29, 5), InStr(Cells(29, 5), ":") + 1, 50)
 
'prestataire
'??
 
'adresse de livraison (si differente)
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 20) = Cells(9, 1)
 
'code postal
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 21) = Cells(10, 1)
 
'ville
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 22) = Cells(10, 2)
 
'pays
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 23) = Cells(11, 1)
 
'date d'envoi
'???
 
'Poids envoi kg
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 25) = Cells(32, 3)
 
'Frais Envoi
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 26) = Cells(32, 5)
 
'FRAIS D'ENVOI REELS
'???
 
'frais Logistique
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 28) = Cells(33, 5)
 
'Ass.% DROUOT
'???
 
'Montant Assurance
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 30) = Cells(34, 5)
 
'TVA
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 31) = Cells(38, 5)
 
'Total HT
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 32) = Cells(37, 5)
 
'Total TTC
Workbooks("BDD.xlsx").Sheets("BDD").Cells(line + i, 33) = Cells(39, 5)
 
Next
 
 
''''SAUVEGARDE ETC''''
 
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
 
End If
Set oCell = Nothing
End With
Next Ws
 
 
End Sub

[Kimy_Ire]

jslpfasc2,

Ca marche très bien chez moi :

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
Option Explicit
 
Sub Recup_Facture()
Dim Ws As Worksheet
Dim oCell As Range
 
'Pour chaque Feuille de mon classeur courant
For Each Ws In Workbooks("Refs.xlsx").Worksheets
    'Avec la feuille BDD de BDD.xlsx (d'ailleurs, cela devrait surement être .xlsm puisque ta macro devrait se trouver dedans)
    With Workbooks("Récup_ref.xlsm").Worksheets("BDD")
        'On fait un recherche de ReferenceFacture.Value (de Ws) dans toute la colonne 1
        Set oCell = .Columns(1).Find(Ws.Cells(3, 4), LookIn:=xlValues, LookAt:=xlWhole)
        'au lieu de la colonne 1 on peut faire la recherche de A2 à la dernière ligne non-vide de la colonne 1 - ci-dessous, ca revient au même
        'Set oCell = Range(.Range("A2"), .Cells(.Rows.Count, 1).End(xlUp)).Find(Ws.ReferenceFacture.Value, LookIn:=xlValues, LookAt:=xlWhole)
 
        'si on ne trouve rien, cela signifie que ta référence n'est pas présente
        If oCell Is Nothing Then
            .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = Ws.Cells(3, 4)
        End If
 
        'Et on remet "rien"
        Set oCell = Nothing
    End With
Next Ws
 
End Sub

Voici les classeurs :

• Récup_ref.xlsm qui lance la macro,
• Refs.xlsx dans lequel j'ai mis des références en D3.

Je te laisse essayer et reviens vers moi pour l'adaptation !

Cordialement,
Kimy

[jslpfasc2]

Re Kimy!

Entre temps j'ai réussi je revenais pour dire que c'était good!

En fait (chez moi en tout cas) le problème venait de :

Code :

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

ThisWorkbook.Worksheets

J'ai remplacé par :

Code :

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

ActiveWorkbook.Worksheets

Et j'ai rajouté avant l'étape de copie un petit :

Code :

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

Ws.Activate

Et tout fonctionne!

En fait chez moi il ne changeait pas de feuille de classeur c'était bizarre...

Bref, grâce à vous tout marche maintenant!
Merci encore!

Bonne soirée,

jslpfasc2