Discussion :

[l'aprentisse]

Bonjour amis Experts,

SVP est ce que vous pouvais m'aider a resoudre mon prob ?

voilà... plutôt que de partir dans des explications :confused:... ici,
je préfère joindre fichier sur lequel j'ai expliqué rapidement et le plus clairement possible mon pb.

Merci pour ce que vous pourrez faire. repertoire.rar

[halaster08]

Bonjour,

Concernant les fichiers joint: http://www.developpez.net/forums/d84...s-discussions/

[l'aprentisse]

Bonjour,

Concernant les fichiers joint: http://www.developpez.net/forums/d84...s-discussions/

Merci de me faire cette remarque

bon d'après le titre de la discussion je veux une macro pour exporter mes données d'un fichier Data vers plusieurs fichier de destination:

1. Le fichier DATA contient un tableau sous cette forme : (N°; Nom complet; pays-chaque pays a au moins 2 colonnes contenant 2 valeurs-)
2. Le nombre des fichiers de destination est en fonction du nombre des colonnes des pays dans le fichier DATA et vous trouver dans la cellule O11 de chaque fichier le nom du pays

alors cette macro va chercher le répertoire contenant les fichiers de destination, puis elle ouvre tous les fichiers Excel un par un et dans chaque fichier il vérifie la cellule O11 si sa contenue se trouve dans le fichier DATA elle export les données qui concerne le contenu de la cellule O11 elle enregistre et ferme le fichier si non elle passe au fichier suivant.

[halaster08]

Et où se trouve le problème?

[l'aprentisse]

Bonjour halaster et merci de votre attention

En tant que débutant en VBA, j'ai du mal à écrire le code de cette macro demandé surtout la partie qui concerne la vérification de la cellule O11 dans chaque fichier

Alors j'aimerais bien que tu m'aide a l'écrire.

Merci d'avance

[halaster08]

En tant que débutant en VBA

Il y a justement sur ce site des tutoriel pour t'aider http://excel.developpez.com/cours/?page=prog#prog

j'ai du mal à écrire le code de cette macro demandé

As tu essayé quelquechose? Pour l'instant on dirait que tu viens avec un cahier des charges et que tu attends qu'on travaille pour toi.

surtout la partie qui concerne la vérification de la cellule O11 dans chaque fichier

il vérifie la cellule O11 si sa contenue se trouve dans le fichier DATA

Regarde l'aide sur la fonction "find" ça devrait t'aider.

[l'aprentisse]

Il y a justement sur ce site des tutoriel pour t'aider http://excel.developpez.com/cours/?page=prog#prog

Pour l'instant on dirait que tu viens avec un cahier des charges et que tu attends qu'on travaille pour toi.

Tout d'abord pour être claire je veux pas que tu travailles pour moi ; j'ai demandé votre aide et c'est pour ça que j'ai ajouté les fichiers joint pour éviter ce mal entendue mais tu ma fais la remarque Concernant les fichiers joint

As tu essayé quelquechose?

Et pour rependre à votre question c'est ça mon essaye
Si tu peux m'orienter à l’adapter avec la question de vérification de la cellule

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
Sub VentilerDonnées()
 
'déclaration de variables
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Dim Chemin As String
Dim Fichier As String
Dim cell As Range, i As Range
 
 
    'ouvre la fenetre pour sélectionner le répertoire de sauvegarde
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
 
    On Error Resume Next
    Set oFolderItem = objFolder.Items.Item
    Chemin = oFolderItem.Path
 
    Application.ScreenUpdating = False
 
    Windows("source.xlsm").Activate
 
    Range("A5").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.Goto Reference:="SourceData"
    Range("D7").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.Goto Reference:="SourceDonnées"
    Range("D6").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Application.Goto Reference:="SourceValeurs"
    Range("B7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.Goto Reference:="SourceClients"
 
 
 'pour chaque pays dans le fichier source: 'le fichier source doit etre actif
    For Each Pays In Range("SourceMatieres")
 
    'recherche du fichier de la matière concernée
    '*******************************************************************
    'Boucle sur tous les fichiers xls du répertoire.
    NomFichier = Dir(Chemin & "\*.xls")
    trouve = False
    Do While Len(NomFichier) > 0 And trouve = False
        If Not NomFichier Like "*" & Export & "*" Then
            NomFichier = Dir()
            trouve = False
        Else: trouve = True
        End If
    Loop
    '********************************************************************
 
    'ouverture du fichier  qui vient d'être récuperé afin de recevoir les données
    Workbooks.Open Filename:=Chemin & "\" & NomFichier
 
          For Each Client In Range("SourceClients")
        'MsgBox Client
        Windows("Data.xlsm").Activate
        'on récupère la note
        note = Range("sourceData").Item(Client.Row, Valeur.Column)
        'dans le fichier de Data
        Windows(NomFichier).Activate
 
        With ActiveWorkbook
            'on cherche la position de l'élève
            Set c = Range("D:D").Find(Client, lookat:=xlWhole)
            If Not c Is Nothing Then
                'et on lui met sa Valeur
                c.Offset(0, 1) = note
            End If
        End With
        'MsgBox ("Client: " & eleve & " Pays: " & Pays & " Valeur: " & Valeur)
         Next Client
 
     'tous les clients ont eu leur Valeur pour le fichier en cours.. on peut fermer avec sauvegarde
    Workbooks(NomFichier).Close savechanges:=True
'on passe au fichier  suivant
Next Pays
Application.ScreenUpdating = True
End Sub

[halaster08]

Bonjour,

Malheureusement, je ne comprends absolument pas ce que tu cherche a faire avec ton code.

Commençons par ç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
    Range("A5").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.Goto Reference:="SourceData"
    Range("D7").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.Goto Reference:="SourceDonnées"
    Range("D6").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Application.Goto Reference:="SourceValeurs"
    Range("B7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.Goto Reference:="SourceClients"

Là tu enchaine des selections sans rien faire.
Tu veux nommer les plages? si oui ce n'est pas Goto qu'il faut utiliser.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
        With ActiveWorkbook
            'on cherche la position de l'élève
            Set c = Range("D:D").Find(Client, lookat:=xlWhole)
            If Not c Is Nothing Then
                'et on lui met sa Valeur
                c.Offset(0, 1) = note
            End If
        End With
        'MsgBox ("Client: " & eleve & " Pays: " & Pays & " Valeur: " & Valeur)
         Next Client

Là tu as visiblement repris un code trouvé ailleurs sans vraiment l'adapter, tu mélanges pays elève note valeur.

[l'aprentisse]

Là tu enchaine des selections sans rien faire.
Tu veux nommer les plages? si oui ce n'est pas Goto qu'il faut utiliser.

En effet c'est ce que je veux faire, alors j’ai enregistré une macro d’où j’ai nommé les plages et c’est ça ce que j’ai obtenue

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
    Range("A5").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.Goto Reference:="SourceData"
    Range("D7").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.Goto Reference:="SourceDonnées"
    Range("D6").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Application.Goto Reference:="SourceValeurs"
    Range("B7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.Goto Reference:="SourceClients"

Et si je dois pas utiliser GoTo alors qu’elle est la fonction qui peut me servir sachant que les plages peuvent être étendu

Là tu as visiblement repris un code trouvé ailleurs sans vraiment l'adapter, tu mélanges pays elève note valeur.

Même si j'ai modifié les erreurs je n’ai pas obtenu les résultats visés

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
        With ActiveWorkbook
            'on cherche la position du Client
            Set c = Range("D:D").Find(Client, lookat:=xlWhole)
            If Not c Is Nothing Then
                'et on lui met sa valeur
                c.Offset(0, 1) = valeur
            End If
        End With
        'MsgBox ("Client: " & Client & " Pays: " & Pays & " valeur: " & valeur)
         Next Client

[halaster08]

"Goto" en français peut se traduire par "aller à" donc ce n'est comme ça qu'on défini une plage nommée.

Pour nommer une plage avec un nouveau nom:
avec une formule:

Code :

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

ctiveWorkbook.Names.Add Name:="test", RefersToR1C1:="=Sheet1!R3C3:R8C5"

avec une selection

Code :

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

ActiveWorkbook.Names.Add Name:="test2", RefersTo:=Selection

Pour changer une plage avec un nom qui existe déjà:

Code :

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

ActiveWorkbook.Names("test").RefersToR1C1 = "=Sheet1!R3C3:R10C5"

Code :

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

ActiveWorkbook.Names("test").RefersTo = Selection

Si je comprends bien, je remplacerais ceci:

Code :

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

1
2
3
4
    Range("A5").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.Goto Reference:="SourceData"

par:

Code :

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

ActiveWorkbook.Names("SourceData").RefersTo = Range("A5").CurrentRegion

Pour le reste, je ne comprends toujours pas ce que tu essaye de faire.

[l'aprentisse]

Bonsoir Mr . halaster08

Merci pour votre temps précieux
Voilà pour t’aider à comprendre mon code afin que tu le corrige je commence à l’explique partie par partie :

1er partie : sert à chercher tous les fichiers Excel dans un répertoire et les ouvrir un par un.

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 VentilerDonnées()
 
'déclaration de variables
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Dim Chemin As String
Dim Fichier As String
Dim cell As Range, i As Range
 
 
    'ouvre la fenetre pour sélectionner le répertoire de sauvegarde
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
 
    On Error Resume Next
    Set oFolderItem = objFolder.Items.Item
    Chemin = oFolderItem.Path
 
    Application.ScreenUpdating = False
 
 'pour chaque pays dans le fichier source: 'le fichier source doit etre actif
    For Each Pays In Range("SourceMatieres")
 
    'recherche du fichier de la matière concernée
    '*******************************************************************
    'Boucle sur tous les fichiers xls du répertoire.
    NomFichier = Dir(Chemin & "\*.xls")
    trouve = False
    Do While Len(NomFichier) > 0 And trouve = False
        If Not NomFichier Like "*" & Export & "*" Then
            NomFichier = Dir()
            trouve = False
        Else: trouve = True
        End If
    Loop
    '********************************************************************
 
    'ouverture du fichier  qui vient d'être récuperé afin de recevoir les données
    Workbooks.Open Filename:=Chemin & "\" & NomFichier

2éme partie : pour cette partie elle cherche chaque client dans le fichier ouvert afin de lui apporter sa valeur du fichier Data.

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
    For Each Client In Range("SourceClients")
        'MsgBox Client
        Windows("Data.xlsm").Activate
        'on récupère la valeur
        valeur = Range("sourceData").Item(Client.Row, Valeur.Column)
        'dans le fichier de Data
        Windows(NomFichier).Activate
 
        With ActiveWorkbook
            'on cherche la position de l'élève
            Set c = Range("D:E").Find(Client, lookat:=xlWhole)
            If Not c Is Nothing Then
                'et on lui met sa Valeur
                c.Offset(0, 2) = valeur
            End If
        End With
        'MsgBox ("Client: " & Client & " Pays: " & Pays & " valeur: " & valeur)
         Next Client
 
     'tous les clients ont eu leur Valeur pour le fichier en cours... on peut fermer avec sauvegarde
    Workbooks(NomFichier).Close savechanges:=True
'on passe au fichier  suivant
Next Pays
Application.ScreenUpdating = True
End Sub

Et pour faciliter les choses voilà mes fichiers