Discussion :

[diver63]

Bonjour à tous,

je sollicite votre aide pour le problème suivant. Précisions, je suis parfaitement novice en VBA et malgré mes recherches je ne m'en sors pas. Peut être ai-je mis la barre un peu haut pour un débutant.
A ce jour une fois par mois j'effectue la copie des valeurs de cellules de fichiers multiples, pour les retranscrire dans un fichier récap sous forme de tableau. Toutes ces manipulations sont longues et fastidieuses et je cherche à automatiser le process.
J'ai un fichier récup.xlsm et j'ai crée un bouton exécution afin de lancer une macro qui me permettrait d'automatiser ce que je fais à la main.
Pb quoi mettre dans le code ?

Pré requis :
- tous mes fichiers "source" sont au format xls
- ils sont tous identiques sur le plan structurel, seul les valeurs de cellules peuvent changer.
- ces valeurs sont numériques ou texte. Si vide la valeur copiée doit être 0.
- ils sont tous rangés dans des dossier différents qui changent chaque mois
- bien qu'identique structurellement, les fichiers portent tous un nom différent qui changent également chaque mois

"Cahier des charges" :
Tous mes fichiers sources sont fermés
lorsque je clique sur le bouton "exécution" de mon fichier récup.xlsm je voudrais qu'une boite de dialogue me permette de sélectionner le répertoire cible ou sont copiés mes fichiers source (ils peuvent être directement à la racine ou dans des sous répertoire).
Le ou les répertoires cible contiennent comme source les fichiers monfic1.xls, monfic2.xls ...etc..etc (ces noms sont aléatoires, ce sont des noms personnels suivis d'une date)
Je voudrais récupérer dans mon fichier récup, à partir de la ligne 3 certaines valeurs des différents fichiers source.
En A3, il faut récupérer le nom du fichier source (exemple monfic1.xls), en B3 la valeur de G6 (de la source), en C3 la valeur de G8, D3 la valeur de W58, E3 la valeur de AH71, F3 la valeur de AI71, G3 la valeur de AJ71.
Une fois cette opération faite, la macro boucle, passe au fichier suivant et recommence la même opération.
Lorsque tous les fichiers du répertoire (et éventuellement des sous rep) ont été balayés, le programme s’arrête.
En résumé, si j'ai 50 fichiers dans mon dossier cible, je me retrouve avec un fichier récup.xlsm avec 50 lignes dont les valeurs ont étaient copiées depuis les sources.
Autre contrainte, je ne veux pas écraser les données déjà collectées.Si je relance l’exécution, il faudrait que la première ligne copiée soit la première ligne vide, soit dans mon exemple ci dessus, la ligne 53.
Si la contrainte de balayage et de traitement de sous répertoire est trop contraignante il est possible de copier tous les fichiers à traiter à la racine d'un même répertoire.

Pour résumé la macro doit exécuter :
- choix du répertoire cible par l'utilisateur
- ouverture du fichier 1
- copie des données sources (fichier 1) vers ligne du tableau récup
- fermeture du fichier 1
- ouverture du fichier 2
- copie des données sources vers ligne suivante du tableau récup
- fermeture du fichier 2
etc ... etc jusqu’à ce que tous les fichiers aient été traités.

Voila mon pb. Pensez vous que cela soit faisable et si oui pouvez vous m'aider à réaliser une telle macro,le but du jeu étant également que je comprenne le code.
Merci

[Philippe Tulliez]

Bonjour,

Pour résumé la macro doit exécuter :
- choix du répertoire cible par l'utilisateur
- ouverture du fichier 1
- copie des données sources (fichier 1) vers ligne du tableau récup
- fermeture du fichier 1
- ouverture du fichier 2
- copie des données sources vers ligne suivante du tableau récup
- fermeture du fichier 2
etc ... etc jusqu’à ce que tous les fichiers aient été traités.

Bien entendu que c'est possible mais comme tu le signales "Précisions, je suis parfaitement novice en VBA", il y a du travail

• choix du répertoire cible par l'utilisateur : Pour choisir un répertoire, il y a Application.FileDialog(msoFileDialogFolderPicker) (Voir exemple en fin de ce fil)
• chercher tous les fichiers présents dans le répertoire sélectionné : Voir fonction Dir
  Voir exemple dans cette discussion

Pour les autres opérations

• ouverture des fichiers 1, 2, 3, etc.
• copie des données sources (fichier 1) vers ligne du tableau récup

Il faut boucler sur l'ensemble des fichiers du répertoire sélectionné (voir l'exemple dans la discussion référencée plus haut)
Pour en savoir plus sur les boucles, à lire La gestion des boucles dans Excel

Pour la copie des données, j'ai écrit une contribution sur le sujet avec une procédure "clé sur porte" qu'il suffit de copier/coller dans un module standard pour l'utiliser
Voir la contribution titrée Regrouper plusieurs feuilles sur une autre. (2003-2010)


Voilà, reviens nous lorsque tu auras pu avancer avec tout cela

Fonction qui renvoie le nom du dossier sélectionné

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Function GetFolder(Optional StrPath As String) As String
  '  http://Philippe.Tulliez.be
  Dim fDlg As FileDialog, sItem As String
  Set fDlg = Application.FileDialog(msoFileDialogFolderPicker)
  If Len(StrPath) = 0 Then StrPath = Application.ActiveWorkbook.Path & "\"
  With fDlg
  .Title = "Selection d'un répertoire"
  .InitialFileName = StrPath
   If .Show = -1 Then GetFolder = .SelectedItems(1)
  End With
 Set fDlg = Nothing
End Function

Exemple de son utilisation

Code :

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

1
2
3
4
5
6
7
8
9
Sub TestGetFolder()
  Dim Folder As String
  Folder = GetFolder(ThisWorkbook.Path)
  If Len(Folder) Then
     MsgBox "Vous avez sélectionné le répertoire : " & Folder
    Else
     MsgBox "Vous n'avez rien sélectionné"
  End If
End Sub

[diver63]

Merci pour votre réponse.

Il est vrai que je pense avoir préjugé de mes capacités, et bien que mon cahier des charges de départ soit intéressant, j'ai un peu réduit mes prétentions.
Toutefois j'ai un peu avancé.
Dans mon fichier test.xlsm, je me suis facilité la vie en créant un bouton qui liste un répertoire et récupère les noms de fichier en hypertexte en colonne A.
Puis j'ai crée une autre macro (bouton) qui ouvre le fichier via le lien récupéré en A3, recopie toutes mes données au bons endroits et referme le fichier.

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
Sub Macro1()
 
    Range("A3").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    Windows("Dupont Daniel 04-2017.xls").Activate
    Range("G6").Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C3").Select
    Windows("Dupont Daniel 04-2017.xls").Activate
    Range("G8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("test.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D3").Select
    Windows("Dupont Daniel 04-2017.xls").Activate
    Range("W58").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("test.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E3").Select
    Windows("Dupont Daniel 04-2017.xls").Activate
    Range("Z60").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("test.xlsm").Activate
    Range("E3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Dupont Daniel 04-2017.xls").Activate
    Range("AH71").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("test.xlsm").Activate
    Range("F3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Dupont Daniel 04-2017.xls").Activate
    Range("AI71").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("test.xlsm").Activate
    Range("G3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Dupont Daniel 04-2017.xls").Activate
    Range("AJ71").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("test.xlsm").Activate
    Range("H3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Dupont Daniel 04-2017.xls").Activate
    ActiveWindow.Close savechanges:=False
End Sub

cela satisfait à mes besoins mais maintenant il faut que je me penche sur une boucle de cette macro qui me permettrait d'ouvrir les liens que j'ai récupéré en colonne A. Pour mes tests j'ai lister une dizaine de fichiers qui sont maintenant en hypertexte de A3 à A12.
Je pense qu'il me faut créer une boucle qui ouvrira et traitera A4, puis A5 ...jusqu’à ce que la cellule Axx soit vide. Je suppose qu'il va me falloir créer des variables et une boucle avec un while et wend mais la j'ai le cerveau qui chauffe et je reprendrai plus tard

[Philippe Tulliez]

Bonjour,
J'avoue ne pas comprendre.
Si tu as su faire une boucle qui place les liens hypertextes dans la colonne A d'une feuille, le travail est le même pour faire une boucle qui ouvre les fichiers d'un répertorie.
De plus si j'ai compris le code que j'ai parcouru en vitesse, placer un lien hypertexte pour aller vers un fichier ouvert (ouvert comment ?) c'est aberrant

[diver63]

Bonjour,

j'ai surtout réussi a trouver une commande qui me permet de faire ce que je voulais (sur ce forum je crois).
J'avoue ne pas tout comprendre mais je l'ai modifié pour mes besoins.

code :

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
Sub test()
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xFiDialog As FileDialog
    Dim xPath As String
    Dim I As Integer
    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
    If xFiDialog.Show = -1 Then
        xPath = xFiDialog.SelectedItems(1)
    End If
    Set xFiDialog = Nothing
    If xPath = "" Then Exit Sub
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xPath)
    For Each xFile In xFolder.Files
        I = I + 1
        ActiveSheet.Hyperlinks.Add Cells(I + 2, 1), xFile.Path, , , xFile.Name
    Next
 
End Sub

ce bouton me permet de lister le répertoire et il me recopie les noms de fichier colonne A en Hypertetxte.
Puis c'est ma seconde macro qui fait le travail de copie. en ligne 3,7 elle ouvre le fichier et en ligne 62 elle le ferme. Entre les 2 elle me copie les valeurs qui intéressement dans mon fichier de récup. Il ya surement plus simple et plus "propre" mais comme je l'ai signalé,je débute.

[Philippe Tulliez]

Bonjour,

ce bouton me permet de lister le répertoire et il me recopie les noms de fichier colonne A en Hypertetxte.

La fonction qui liste les fichiers contenus dans un répertoire, je t'ai donné le lien avec code source + exemple (En plus l'exemple ouvre les fichiers)

chercher tous les fichiers présents dans le répertoire sélectionné : Voir fonction Dir
Voir exemple dans cette discussion

[clementmarcotte]

Bonjour,

Moi, savoir que mon employeur gère des informations confidentielles sur les employés dans des fichiers Excel, je virerais rouge. Quand on pense que l'on peut trouver des SGBD gratuits et mieux sécurisés, même SQLServer Express.

Pourquoi pas avec le Bloc-notes, tant qu'à y être ?

Visiblement, la CNIL et les organismes équivalents ne se préoccupent pas trop des forums. Sinon, il y a un paquet d'entreprises qui se feraient taper sur les doigts avec une masse.

Si c'était moi qui décidait, j'interdirais de poser, et d'y répondre, toute question portant sur des fichiers Excel et la gestion des individus. C'est juste trop grave. Mais, il faut répondre aux questions.

[diver63]

Bonjour,

pour affirmer comme vous le faites que les données sont confidentielles, encore faut il connaitre leur contenu. De plus si cela est fait en respectant la RGPD ...
Pour info, mes fichier "cible" sont des fichiers déclaratifs directement remplis par les collaborateurs.
Tous les mois je dois collecter une dizaine de cellules pour constituer un tableau de récap.
Comme je suis fainéant et que je n'ai pas envie d'ouvrir tous les fichiers ou de faire des copies entre classeur (ou mettre toutes les feuilles dans un classeur ....) je me suis dit qu'une macro serait pratique.
De plus pour ma culture personnelle, cela me paraissait être un challenge intéressant.
Seulement, étant complètement néophyte dans l'art de la programmation VBA, je pense que la marche est trop haute pour mon faible niveau.
Pour moi, variable, fonction, objet etc...etc... c'est du chinois.
Bref je vais continuer de potasser et consulter les forums en essayant de progresser et de me déme....der tout seul.

bien à vous,

[Philippe Tulliez]

Bonjour,

Comme je suis fainéant et que je n'ai pas envie d'ouvrir tous les fichiers ou de faire des copies entre classeur (ou mettre toutes les feuilles dans un classeur ....) je me suis dit qu'une macro serait pratique

Moi également. C'est la raison pour laquelle je me suis lancé dans l'apprentissage de la programmation alors que je n'ai aucune formation dans ce domaine.

Seulement, étant complètement néophyte dans l'art de la programmation VBA, je pense que la marche est trop haute pour mon faible niveau.
Pour moi, variable, fonction, objet etc...etc... c'est du chinois.

C'est tout de même le minimum à connaître
A lire pour commencer

• Formation Excel - VBA débutant
• Excel et Visual Basic : Tutoriel
• Initiation au VBA Office

Bref je vais continuer de potasser et consulter les forums en essayant de progresser et de me déme....der tout seul.

Avec les liens et codes que j'ai publiés et d'après ce que tu as demandé au départ, il suffit de faire un Copier/Coller de ceux-ci et ensuite de créer une procédure qui les invoque

Evidemment cela demande un minimum de temps à consacrer (pour info, en 1999, j'ai consacré +/- 4 heures par jours sur les forums et ce pendant 3 mois pour automatiser mes offres qui me prenait 2 heures par offre et au bout du compte, je suis passé à 10 minutes par offre et sans erreur)

A toi de voir soit tu rémunères un consultant spécialiste en VBA et Excel qui te facturera au maximum 6 heures pour ce travail, soit tu apprends avec les aides reçues sur ce forum et oui, il faudra du temps pour appréhender ce langage.

[diver63]

Bonjour,

suivant vos conseils, je vais potasser les "à lire pour commencer".
Enfin, je suis content de moi car je suis arrivé à mes fins. Bon tout n'est pas parfait, mais cela fonctionne et cela fait le job.
Suivant vos conseils, j'ai crée un bouton qui me liste un répertoire. Puis j'ai fait une macro qui boucle et me copie les cellules qui m'interressent.
Bon j'ai fait ça en piquant du code à droite et à gauche, en essayant de le comprendre et en l'adaptant à mes besoins.
Je pense qu'il y a surement des moyens de faire plus propre et plus rapide, mais je ferai ça quand je serais "grand"

Ci joint le code du listing

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub Macro2()
repertoire = "c:\data\"
 I = 3
 nf = Dir(repertoire & "\*.*")
 Do While nf <> ""
 Cells(I, 1) = nf
 nf = Dir
 I = I + 1
 Loop
End Sub

Puis celui de la copie des données.

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
Sub Macro1()
 
        Dim ligne As Long
        ligne = 3
 
 
                While Cells(ligne, 1) <> ""
 
        valeur = Cells(ligne, 1).Value
 
    Cells(ligne, 1).Select
    Workbooks.Open Filename:="c:\data\" & valeur & ""
    Windows(valeur).Activate
    Range("G6").Select
    Selection.Copy
    Windows("Récupération variables paye.xlsm").Activate
    Cells(ligne, 2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Cells(ligne, 3).Select
    Windows(valeur).Activate
    Range("G8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Récupération variables paye.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Cells(ligne, 4).Select
    Windows(valeur).Activate
    Range("W58").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Récupération variables paye.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Cells(ligne, 5).Select
    Windows(valeur).Activate
    Range("Z60").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Récupération variables paye.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Cells(ligne, 6).Select
    Windows(valeur).Activate
    Range("AH71").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Récupération variables paye.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Cells(ligne, 7).Select
    Windows(valeur).Activate
    Range("AI71").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Récupération variables paye.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Cells(ligne, 8).Select
    Windows(valeur).Activate
    Range("AJ71").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Récupération variables paye.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Windows(valeur).Activate
    ActiveWindow.Close savechanges:=False
 
        ligne = ligne + 1
 
            Wend
End Sub

Si vous avez le temps d'y jeter un oeil et me dire ce que vous en pensez.

Je vous remercie.