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