Discussion :

[IcedTeaLyon]

Bonjour à tous

J'ai vu que des discussions avaient déjà été ouvertes sur des sujets similaires, mais après quelques heures à essayer de m'en sortir seul, j'abdique et je tente la demande d'entre-aide.

J'ai un dossier contenant des fichiers Excel qui sont remplis par des individus (réponses à des questionnaires) que je cherche à regrouper en un seul fichier type BDD (les questionnaires sont sur plusieurs feuilles, mais tous les fichiers sont identiques dans leur structure par contre, et même dossier).

J'ai besoin que dans la première colonne de mon fichier BDD apparaisse le nom du fichier. J'ai tenté de le faire dans la macro suivante, mais ça ne marche pas. Je n’ai pas de l’utiliser la bonne formule.

J'aimerais aussi pouvoir copier / coller-transposer (uniquement les valeurs) à la suite du premier coller les résultats des feuilles suivantes, mais là aussi je n'arrive pas à coder correctement.

Je vous mets l'exemple de mon fichier source et de mon fichier base de données et le code que j'ai tenté d'écrire.

Merci énormément pour votre aide et vos conseils.

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
 
Sub Extraire()
 
Application.ScreenUpdating = False
 
Dim Fichier As String
Dim Chemin As String
Dim ClasseurSource As Workbook
Dim valeur1 As String
 
 
 
valeur1 = ThisWorkbook.Worksheets("Synth").Range("A1").Value
Chemin = "C:\Users\...\questionnaire adulte complémentaire\" & valeur1 & "\" 'Chemin du répertoire contenant les fichiers
Fichier = Dir(Chemin & "Cotation autoquestionnaire complementaire*.xlsx")
 
Do While Fichier <> ""
    Set ClasseurSource = Workbooks.Open(Chemin & Fichier)
[ATTACH]418477[/ATTACH][ATTACH]418478[/ATTACH]
     ClasseurSource.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert = "nom de fichier"
 
    ClasseurSource.Worksheets("YFAS 2").Range("D2:D89").Copy
    ThisWorkbook.Worksheets("Synth").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
 
 
 ClasseurSource.Close
 Fichier = Dir
Loop
 
End Sub

Merci de votre aide
NB : j'ai aussi un petit souci sous Mac, il ne trouve pas le lien vers mon dossier, y'a une subtilité que je n'ai pas du saisir

[Menhir]

N'ayant pas ouvert tes fichiers joints (entre autre pour les raisons expliquées ici https://www.developpez.net/forums/d8...s-discussions/ ), je n'ai pas compris toutes tes explications.

J'ai quand même vu ça qui pique les yeux :

Code :

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

     ClasseurSource.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert = "nom de fichier"

Tu aurais dû au moins consulter l'aide VBA sur la méthode Insert.

Je pense (sans certitude) que ceci correspondra mieux à ce que tu souhaites.

Code :

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

     Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = ActiveWorkbook.Name

NB : j'ai aussi un petit souci sous Mac, il ne trouve pas le lien vers mon dossier, y'a une subtilité que je n'ai pas du saisir

C'est normal puisque sur Mac les structures des chemins (en particulier les séparateurs) ne sont pas les mêmes.

[Thautheme]

Bonjour le fil, bonjour le forum,

Peut-être 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
Sub Extraire()
Dim CD As Workbook
Dim OD As Worksheet
Dim CS As Workbook
Dim OS As Worksheet
Dim Fichier As String
Dim Chemin As String
Dim valeur1 As String
Dim DEST As Range
 
Application.ScreenUpdating = False
Set CD = ThisWorkbook
Set OD = CD.Worksheets("Synth")
valeur1 = OD.Range("A1").Value
Chemin = "C:\Users\...\questionnaire adulte complŽmentaire\" & valeur1 & "\" 'Chemin du rŽpertoire contenant les fichiers
Fichier = Dir(Chemin & "Cotation autoquestionnaire complementaire*.xlsx")
Do While Fichier <> ""
    Set CS = Workbooks.Open(Chemin & Fichier)
    Set OS = CS.Worksheets("YFAS 2")
    Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)
    DEST.Value = CS.Name
    DEST.Offset(0, 1).Resize(1, 88).Value = Application.Transpose(OS.Range("D2:D89"))
    CS.Close False
    Fichier = Dir
Loop
End Sub