Boucle rechercheV sur plusieurs fichiers

**legenuis** · 18/11/2011, 02h07

Bonjour le forum, bonjour à tous,

Voici mon problème :

J’ai 6 fichiers : 1 source et 5 clients.
Le fichier source contient 2 onglets : « Total » et « Recap ».

« Total » somme mensuellement pour chacune des références qu’il trouve, les quantités contenues dans chacun des fichiers clients. (vision : somme ref/mois pour tous les clients)
« Recap » somme par client le total des refs. (vision : somme ref/client au total)

Synopsis de la macro (fichier source) :
J’ouvre tous les fichiers clients, je cherche si ma réf est dans le fichier client, si oui alors je recopie son contenu mois/mois dans l’onglet « Total »;si non alors je passe à la ref suivante. Une fois tout ceci terminé, je récapitule, pour chacune des réfs, leurs totaux/client dans l’onglet « Recap ».

Contraintes :
1* Durant ma recherche, si je trouve une réf dans le fichier et qu’elle n’y est pas dans le fichier source alors je la rajoute dans le fichier source et recopie ses données. (Voilà pourquoi la macro « Total » doit être lancée avant « Recap »).
2* Si le statut (colonne A) est à « 0 » je barre tout le contenu de la ligne sauf la colonne A et je ne fais pas de total sur cette ligne.
3* Une fois la recherche terminée, les fichiers (que la macro a du ouvir - je pense-) se refrment automatiquement.

Ci-joint le dossier pour plus de clarté.

Merci infiniment.

**Daniel.C** · 18/11/2011, 12h27

Bonjour,

2* Si le statut (colonne A) est à « 0 » je barre tout le contenu de la ligne sauf la colonne A et je ne fais pas de total sur cette ligne.

Peux-tu expliciter "je barre" ?

Est-ce que tu parles du statut du classeur source ? Il y a également des statuts à 0 dans les classeurs clients. Que fait-on ?

**legenuis** · 18/11/2011, 23h45

Barrer les lignes dans le fichier client uniquement comme ~~ceci~~

Et ainsi le total de la ligne barrée ne doit pas se faire.

Le plus important est surtout la macro "recap" que je n'arrive pas à démarrer.

**Daniel.C** · 19/11/2011, 18h53

Regarde ce premier jet :

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
Sub Importer()
    Dim Fich As String, Chemin As String, Wb As Workbook
    Dim c As Range, Teste As Variant, Plage As Range, Ligne As Long
    Dim Col As Integer
    With ThisWorkbook.Sheets("Total")
        Set Plage = .Range(.[B5], .Cells(.Rows.Count, 2).End(xlUp))
    End With
    Chemin = ThisWorkbook.Path    '*** à modifier éventuellement
    Fich = Dir(Chemin & "\*.xls")
    Do While Fich <> ""
        If LCase(Left(Fich, 6)) = "client" Then    '*** à modifier éventuellement
        With ThisWorkbook.Sheets("Total")
            Set Wb = Workbooks.Open(Chemin & "\" & Fich)
'****Traitement de la feuille Total
            For Each c In Range([B5], Cells(Rows.Count, 2).End(xlUp))
                If c.Offset(, -1) <> 0 Then
                    Teste = Application.Match(c.Value, Plage, 0)
                    If IsNumeric(Teste) Then
                        Teste = Teste + 4
                        For i = 3 To 14
                            .Cells(Teste, i).Value = .Cells(Teste, i).Value + Cells(c.Row, i).Value
                        Next i
                    Else
                        Ligne = .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Row
                        Range(Cells(c.Row, 1), Cells(c.Row, 14)).Copy .Cells(Ligne, 1)
                    End If
                Else
                    Range(Cells(c.Row, 1), Cells(c.Row, 14)).Font.Strikethrough = True
                End If
            Next c
        End With
'****Traitement de la feuille Recap
            With ThisWorkbook.Sheets("Recap")
                Set Plage = .Range(.[B5], .Cells(.Rows.Count, 2).End(xlUp))
                For Each c In Range([B5], Cells(Rows.Count, 2).End(xlUp))
                    If c.Offset(, -1) <> 0 Then
                        Col = Application.Match([B2].Value, .Rows(3), 0)
                        Teste = Application.Match(c.Value, Plage, 0)
                        If IsNumeric(Teste) Then
                            Teste = Teste + 4
                            .Cells(Teste, Col).Value = Application.Sum(Range(Cells(c.Row, 3), Cells(c.Row, 14)))
                        Else
                            Ligne = .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Row
                            Range(Cells(c.Row, 1), Cells(c.Row, 2)).Copy .Cells(Ligne, 1)
                            Rows(Ligne - 1).Copy
                            Rows(Ligne).PasteSpecial xlPasteFormats
                        End If
                    End If
                Next c
            End With
                    End If
            Wb.Close True
            Fich = Dir
        Loop
End Sub

**legenuis** · 19/11/2011, 19h28

Merci, c du code ça! mais ça marche à 80%

J'ai en fait une erreur du type: la méthode close de l'objet _workbook a échoué.

De plus la dernière ref 10002630 qui n'existe pas dans le fichier source mais uniquement dans les fichiers clients n'est pas recopiée dans le fichier source (c'est le coeur de ma requête) ...

Et les fichiers ne s’appelleront pas toujours "client" mais auront des noms quelconques...parce que dans ton code tu demande juste de chercher guache de "client"...

Merci

fichier ci joint

**Daniel.C** · 19/11/2011, 21h55

De plus la dernière ref 10002630 qui n'existe pas dans le fichier source mais uniquement dans les fichiers clients n'est pas recopiée dans le fichier source (c'est le coeur de ma requête) ...

mais :

1* Durant ma recherche, si je trouve une réf dans le fichier et qu’elle n’y est pas dans le fichier source alors je la rajoute dans le fichier source

Que faire ?

J'ai en fait une erreur du type: la méthode close de l'objet _workbook a échoué.

Quel est le fichier client ouvert quand cette erreur se produit ?

Et les fichiers ne s’appelleront pas toujours "client" mais auront des noms quelconques

Comment les reconnait-on ?

**legenuis** · 19/11/2011, 23h40

Ok je vois.

En fait le but est de récupérer les ref qui sont présentes dans le fichiers clients et les incorporer dans le fichier source (s'ils n'y sont pas) et la ligne qui va avec (c'et vraiment le coeur, et qui dépasse mes maigres capacités en VBA)

Pour les noms de fichiers, ce seront des noms des pays, au total 100!!!

L'erreur se produit en fin d'écution, tous les fichiers client étant déja fermé (c curieux)

Pour info, voici la liste des pays:

AFS
Allemagne
Australie
Autriche
Azerbaïdjan
Bélarus
Belgique
Bosnie
Brésil
Bulgarie
Canada
Chine
Chypre
Colombie
Corée du Sud
Croatie
Émirats arab.
Espagne
Estonie
États-Unis
Finlande
France
Géorgie
Grèce
Guadeloupe
Hong Kong
Hongrie
Indonésie
Irlande
Israël
Italie
Japon
Kazakhstan
Lettonie
Liban
Lituanie
Malaisie
Malte
Maroc
Maurice
Mexique
Myanmar
Norvège
N. Calédonie
N. Zélande
Panama
Paraguay
Pays-Bas
Philippines
Pologne
Portugal
Réunion
Roumanie
Royaume-Uni
Russie
Serbie
Singapour
Slovénie
Suède
Suisse
St Martin
Taïwan (Chine)
Tchèque
Thaïlande
Tunisie
Turquie
Ukraine
Uruguay
Viet Nam

Merci

**Daniel.C** · 20/11/2011, 11h55

C'est une liste limitative ? Je peux les coder en dur dans la macro mais perso, je mettrais la liste dans une feuille du fichier source. La feuille pourrait être éventuellement cachée. Ou dans un autre classeur. Le top est bien sûr d'isoler les classeurs dans dans un même dossier.

Je regarde pour l'erreur.

Voici le code rectifié :

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
Sub Importer()
    'Réf Source.xls legenuis
    Dim Fich As String, Chemin As String, Wb As Workbook
    Dim c As Range, Teste As Variant, Plage As Range, Ligne As Long
    Dim Col As Integer
    With ThisWorkbook.Sheets("Total")
        Set Plage = .Range(.[B5], .Cells(.Rows.Count, 2).End(xlUp))
    End With
    Chemin = ThisWorkbook.Path    '*** à modifier éventuellement
    Fich = Dir(Chemin & "\*.xls")
    Do While Fich <> ""
        If LCase(Left(Fich, 6)) = "client" Then    '*** à modifier éventuellement
        With ThisWorkbook.Sheets("Total")
            Set Wb = Workbooks.Open(Chemin & "\" & Fich)
'****Traitement de la feuille Total
            For Each c In Range([B5], Cells(Rows.Count, 2).End(xlUp))
                If c.Offset(, -1) <> 0 Then
                    Teste = Application.Match(c.Value, Plage, 0)
                    If IsNumeric(Teste) Then
                        Teste = Teste + 4
                        For i = 3 To 14
                            .Cells(Teste, i).Value = .Cells(Teste, i).Value + Cells(c.Row, i).Value
                        Next i
                    Else
                        Ligne = .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Row
                        Range(Cells(c.Row, 1), Cells(c.Row, 14)).Copy .Cells(Ligne, 1)
                    End If
                Else
                    Range(Cells(c.Row, 1), Cells(c.Row, 14)).Font.Strikethrough = True
                End If
            Next c
        End With
'****Traitement de la feuille Recap
            With ThisWorkbook.Sheets("Recap")
                Set Plage = .Range(.[B5], .Cells(.Rows.Count, 2).End(xlUp))
                For Each c In Range([B5], Cells(Rows.Count, 2).End(xlUp))
                    If c.Offset(, -1) <> 0 Then
                        Col = Application.Match([B2].Value, .Rows(3), 0)
                        Teste = Application.Match(c.Value, Plage, 0)
                        If IsNumeric(Teste) Then
                            Teste = Teste + 4
                            .Cells(Teste, Col).Value = Application.Sum(Range(Cells(c.Row, 3), Cells(c.Row, 14)))
                        Else
                            Ligne = .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Row
                            Range(Cells(c.Row, 1), Cells(c.Row, 2)).Copy .Cells(Ligne, 1)
                            Rows(Ligne - 1).Copy
                            Rows(Ligne).PasteSpecial xlPasteFormats
                        End If
                    End If
                Next c
            End With
            Wb.Close True
            End If
            Fich = Dir
        Loop
End Sub

**legenuis** · 20/11/2011, 21h47

Envoyé par Daniel.C

C'est une liste limitative ? Je peux les coder en dur dans la macro mais perso, je mettrais la liste dans une feuille du fichier source. La feuille pourrait être éventuellement cachée. Ou dans un autre classeur. Le top est bien sûr d'isoler les classeurs dans dans un même dossier.

Je regarde pour l'erreur.

Parfait! Les fichiers client seront tous dans un même dossier. La liste est exhaustive en effet.

Merci

J'ai toujours la même erreur. J'ai l'impression que le code n'arrive pas à insérer dans le fichier source les réfs qui existent dans les fichiers clients

J'ai suivi ton conseil (dsl ne l'avoir pas fait plus tô):

J'ai réorganiser les fichiers : j'ai renommé les clients par noms de pays et je les ai placé dans un repertoire "Pays".

Si on est tous d'accord :
- la macro va chercher dans le repertoire "Pays" tous les fichiers en extensions ".xls".
- La macro regarde d'abord la ref contenu dans le fichier pays puis la cherche dans le fichier source, si elle existe : elle cumule la quantité trouvée si elle n'existe pas elle la rajoute (recopie toute la ligne)
- Ensuite, elle démarre à partir des ref contenues dans "Total" du fichier source, recherche les totaux de chacune des ref dans les fichiers clients et les cumules dans l'onglet "recap" du fichier source.

C'est facile à dire pour moi qu'à faire....

Mais Daniel tu es apparemment mon seul espoir....

Je te joinds l'ensemble du dossier reorganisé.

Merci

**Daniel.C** · 21/11/2011, 12h51

Tu as oublié la pièce jointe.

**legenuis** · 21/11/2011, 13h33

OUPS!

Le voila

dsl

Et j'ai l'impression que le code n'arrive pas à gérer plus de 2 ref non présentent dans le ficheir source, il fait le recap sur une seulle et dans l'onglet total, il barre les nouvelle même quand le statut est à un...

**legenuis** · 21/11/2011, 13h35

Voici un code qui marche bien pour l'onglet Total mais je n'arrive pa à l'adapter avec ton code pour faire le "Recap"... Could you get an eye please ?

Merci

**Daniel.C** · 21/11/2011, 15h12

Le problème vient du fait qu'en scindant la macro, tu as enlevé l'ouverture des classeurs pays. Je l'ai rajoutée :

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
Sub Importer()
    Dim Fich As String, Chemin As String, Wb As Workbook
    Dim c As Range, Teste As Variant, Plage As Range, Ligne As Long
    Dim Col As Integer
    With ThisWorkbook.Sheets("Total")
        Set Plage = .Range(.[B5], .Cells(.Rows.Count, 2).End(xlUp))
    End With
    Chemin = ThisWorkbook.Path    '*** à modifier éventuellement
    Fich = Dir(Chemin & "\Pays\*.xls")
    Do While Fich <> ""
 
'****Traitement de la feuille Recap
            Workbooks.Open Chemin & "\Pays\" & Fich
            With ThisWorkbook.Sheets("Recap")
                Set Plage = .Range(.[B5], .Cells(.Rows.Count, 2).End(xlUp))
                For Each c In Range([B5], Cells(Rows.Count, 2).End(xlUp))
                    Var = c.Offset(, -1)
                    If c.Offset(, -1) <> 0 Then
                        Col = Application.Match([B2].Value, .Rows(3), 0)
                        Teste = Application.Match(c.Value, Plage, 0)
                        If IsNumeric(Teste) Then
                            Teste = Teste + 5
                            .Cells(Teste, Col).Value = Application.Sum(Range(Cells(c.Row, 3), Cells(c.Row, 14)))
                        Else
                            Ligne = .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Row
                            Range(Cells(c.Row, 1), Cells(c.Row, 2)).Copy .Cells(Ligne, 1)
                            .Rows(Ligne - 1).Copy
                            .Rows(Ligne).PasteSpecial xlPasteFormats
                        End If
                    End If
                Next c
            End With
 
            ActiveWorkbook.Close True
            Fich = Dir
        Loop
End Sub

**legenuis** · 21/11/2011, 20h46

Ah oui!

Ca marche mieux maintenant SAUF que les totaux dans l'onglet "Recap" ne sont plus justes à la ref (en fait il doit avoir un paramètre a règler quand la macro a rencontré une nouvelle ref - Ton code "Recap" prend bien son départ dans l'onglet "Total" n'est-ce pas ?...

Je me demande se que je serai devenu sans ton aide...

**Daniel.C** · 21/11/2011, 21h48

Non, je fais tout depuis les fichiers pays. Donne-moi un exemple de référence fausse.

**legenuis** · 21/11/2011, 23h59

Envoyé par Daniel.C

Non, je fais tout depuis les fichiers pays. Donne-moi un exemple de référence fausse.

Etat:
La ref 10002630 est présente dans 2 pays (100/mois) : la France et l'Italie.

La ref 10002631 est présente uniquement (100/mois) dans la France.

Aucune des 2 ref n'a volontairement été référée dans le fichier source.

Résultat de la macro:

Dans l'onglet "Total" :

- 10002630: 200/mois soit 2400 au total (juste)
- 10002631: 100/mois soit 1200 au total (juste)

Dans l'onglet "Recap" :

- 10002630: 0/mois soit 0 pour la France et 0 pour l'Italie (faux)
- 10002631: 1200 pour l'Italie (faux) - Ces 1200 correspondent à la France.

------------------------------------------

On est pas obligé de respecter l'ordre d'inscription des clients mais leur quantité respective. Libre donc à toi d'inscrire le nom du fichier (Pays) en ligne "3" après ou avant récapitulatif de ses quantités OU partir du nom indiqué pour récapituler les quantités du fichier correspondant....ouf!

Merci pour ton aide merci au forum, c'est encourageant

**Daniel.C** · 22/11/2011, 11h48

Au temps pour 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
27
28
29
30
31
32
33
34
35
36
37
Sub Importer()
    Dim Fich As String, Chemin As String, Wb As Workbook
    Dim c As Range, Teste As Variant, Plage As Range, Ligne As Long
    Dim Col As Integer
    With ThisWorkbook.Sheets("Total")
        Set Plage = .Range(.[B5], .Cells(.Rows.Count, 2).End(xlUp))
    End With
    Chemin = ThisWorkbook.Path    '*** à modifier éventuellement
    Fich = Dir(Chemin & "\Pays\*.xls")
    Do While Fich <> ""
 
'****Traitement de la feuille Recap
            Workbooks.Open Chemin & "\Pays\" & Fich
            With ThisWorkbook.Sheets("Recap")
                Set Plage = .Range(.[B5], .Cells(.Rows.Count, 2).End(xlUp))
                For Each c In Range([B5], Cells(Rows.Count, 2).End(xlUp))
                    'If c.Value = 10002630 Then Stop
                    If c.Offset(, -1) <> 0 Then
                        Col = Application.Match([B2].Value, .Rows(3), 0)
                        Teste = Application.Match(c.Value, Plage, 0)
                        If IsNumeric(Teste) Then
                            Teste = Teste + 4
                            .Cells(Teste, Col).Value = Application.Sum(Range(Cells(c.Row, 3), Cells(c.Row, 14)))
                        Else
                            Ligne = .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Row
                            Range(Cells(c.Row, 1), Cells(c.Row, 2)).Copy .Cells(Ligne, 1)
                            .Rows(Ligne - 1).Copy
                            .Rows(Ligne).PasteSpecial xlPasteFormats
                        End If
                    End If
                Next c
            End With
 
            ActiveWorkbook.Close True
            Fich = Dir
        Loop
End Sub

**legenuis** · 22/11/2011, 17h29

Daniel,

Il doit persister un petit problème de "Pays" ou "Client"...

La macro cette fois récapitule juste la nouvelle ref de l'Italie mais pas les 2 nouvelles de la France...

Et si je rajoute une nouvelle ref à un pays quelconque (ex: Suisse); la ref est bien intégrée dans l'onglet recap mais pas la quantité qui va vec le pays...
this is it !

ci-joint le dossier (j'ai colorié en rouge les cellule defaillantes dans l'onglet recap)

Merci infiniment.

**Daniel.C** · 22/11/2011, 19h35

Micro climat ?

Avec les nouveaux fichiers, j'obtiens :

10002629 France 0 (le statut est 0)
10002630 France 1200
10002632 Suisse 1200.

Je viens de comprendre pour la Suisse et peut-être pour les autres cas aussi. Essaie :

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
Sub Importer()
    Dim Fich As String, Chemin As String, Wb As Workbook
    Dim c As Range, Teste As Variant, Plage As Range, Ligne As Long
    Dim Col As Integer
    With ThisWorkbook.Sheets("Total")
        Set Plage = .Range(.[B5], .Cells(.Rows.Count, 2).End(xlUp))
    End With
    Chemin = ThisWorkbook.Path    '*** à modifier éventuellement
    Fich = Dir(Chemin & "\Pays\*.xls")
    Do While Fich <> ""
 
'****Traitement de la feuille Recap
            Workbooks.Open Chemin & "\Pays\" & Fich
            With ThisWorkbook.Sheets("Recap")
                Set Plage = .Range(.[B5], .Cells(.Rows.Count, 2).End(xlUp))
                For Each c In Range([B5], Cells(Rows.Count, 2).End(xlUp))
                    'If c.Value = 10002630 Then Stop
                    If c.Offset(, -1) <> 0 Then
                        Col = Application.Match([B2].Value, .Rows(3), 0)
                        Teste = Application.Match(c.Value, Plage, 0)
                        If IsNumeric(Teste) Then
                            Teste = Teste + 4
                            .Cells(Teste, Col).Value = Application.Sum(Range(Cells(c.Row, 3), Cells(c.Row, 14)))
                        Else
                            Ligne = .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Row
                            Range(Cells(c.Row, 1), Cells(c.Row, 2)).Copy .Cells(Ligne, 1)
                            .Rows(Ligne - 1).Copy
                            .Rows(Ligne).PasteSpecial xlPasteFormats
                            .Cells(Ligne, Col).Value = Application.Sum(Range(Cells(c.Row, 3), Cells(c.Row, 14)))
                        End If
                    End If
                Next c
            End With
 
            ActiveWorkbook.Close True
            Fich = Dir
        Loop
End Sub

**legenuis** · 22/11/2011, 22h27

Alleluyahhhhhhhhhhhhhh!!!!

Bravo Daniel, la cette fois c bon, l'onglet "recap" respecte bien le pays et l'affecte les bonnes quantités SAUF QUE

:

- Tu demandes à la macro de recopier "le format de ligne de dessus" s'il trouve une nouvelle ref...

Le format de la ligne doit dépendre plutot du "statut" de la ref "1" ou "0". 1= OK et "0" = ref annulée donc on barre la ligne ~~comme ceci~~

C'est ce que fait la macro "Total" en fait, mais moi j'arrive pas à reproduire ça dans ton code...moi je suis novice en VBA

C'est passionnant ce truc !

Merci

Boucle rechercheV sur plusieurs fichiers

Macros et VBA Excel

Discussions similaires

Partager

Partager