Discussion :

[alucard_xs]

bonsoir à tous,

j'ai quelques bases (on va dire ça en vba) mais insuffisantes visiblement ...
j'ai plusieurs fichier .xls dans le répertoire c:\toto
, nommés david1.xls, david2.xls et david3.xls, etc ... n fichiers disons.

Chaque fichier a la même structure, c'est à dire une seule feuille nommée Feuill1, avec pour chacun certaines cellules de remplie : C1, D13, F14, etc ...
je souhaiterai pouvoir concaténer l'ensemble de mes fichiers de telle manière à n'avoir qu'un seul fichier.

Donc en clair, je souhaiterai avoir une ligne pour "résumer" chacun des fichiers.
fichier global :
ligne 1, cellule1=valeur(C1,david1.xls), , cellule2=valeur(D13,david1.xls),,,
ligne 2, cellule1=valeur(C1,david2.xls), , cellule2=valeur(D13,david2.xls),,,

Est-ce possible d'automatiser ça ?

Merci pour votre aide

[electrons]

Bonsoir,
Je ne peux répondre à ton problème ce soir car je suis sur un "Appel", incompatible pour excel avec "macro"
J'ai du résoudre le même problème et je t'enverrai le code demain, du moins, une solution possible.

A demain.

[alucard_xs]

merci de ta participation déjà

[alucard_xs]

pour plus de renseignements, c'est comme si j'avais n questionnaires de remplis par n personnes, et que je souhaites tout mettre dans un seul fichier excel avec en ligne 2 par exemple, les réponse de la personne 2, etc ... C'est pas un copier coller de la feuille du questionnaire, c'est juste que je souhaite prendre les mêmes cases d'un questionnaire à un autre (cases C1, D13, etc.)
Mon niveau de VBA est carrément rouillé à vrai dire ...

en PJ : les deux fichiers et le fichier de synthèse tant désiré.

up : j'ai essayé cela mais ça n'en veut pas visiblement, un truc plante ...

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
Private Sub CommandButton1_Click()
 
Range("A1").Select 'sélectionner la cellule de début
Chemin = "D:\checklist\"
fichier = Dir(Chemin & "*.xls")
Do While fichier <> ""
Workbooks.Open Filename:=Chemin & fichier
Set feuille = ActiveWorkbook.Sheets("Feuil2")
 
ThisWorkbook.Activate
ActiveCell.Value = feuille.Range("C3").Value
ActiveCell.Offset(0, 1).Value = feuille.Range("C7").Value
ActiveCell.Offset(0, 2).Value = feuille.Range("E5").Value
ActiveCell.Offset(0, 3).Value = feuille.Range("E13").Value
ActiveCell.Offset(0, 4).Value = feuille.Range("G24").Value
ActiveCell.Offset(0, 5).Value = feuille.Range("E25").Value
 
Windows(fichier).Close savechanges:=False
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
fichier = Dir ' Fichier suivant
Loop
 
 
 
End Sub

merci

[electrons]

Bonjour,

Comme promis, voici le code que j'ai utilisé pour récupérer des données dans plusieurs fichiers d'un même répertoire (ici, tous les fichiers d'extension ".xls") et les concaténer dans un seul.

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 Macro1()
 
'
Dim NomFichier As String, i As Long, DerLine As Long
Dim Resultat As String
 
    i = 1
    DerLine = Sheets("Cible").Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
 
    ThisWorkbook.Sheets("Cible").Range("K1").Value = DerLine
    i = DerLine
 
    NomFichier = Dir("c:\vero\")
 
    Do While NomFichier <> ""
       If Right(NomFichier, 4) = ".xls" Then
           i = i + 1
           Resultat = "c:\vero\" & NomFichier
           Workbooks.Open Resultat
 
           ThisWorkbook.Sheets("Cible").Range("A" & i).Value = Workbooks(NomFichier).Sheets(1).Range("A1").Value
           ThisWorkbook.Sheets("Cible").Range("B" & i).Value = Workbooks(NomFichier).Sheets(1).Range("D1").Value
           ThisWorkbook.Sheets("Cible").Range("C" & i).Value = Workbooks(NomFichier).Sheets(1).Range("B4").Value
           ThisWorkbook.Sheets("Cible").Range("D" & i).Value = Workbooks(NomFichier).Sheets(1).Range("B5").Value
           ThisWorkbook.Sheets("Cible").Range("E" & i).Value = Workbooks(NomFichier).Sheets(1).Range("C4").Value
           ThisWorkbook.Sheets("Cible").Range("F" & i).Value = Workbooks(NomFichier).Sheets(1).Range("C5").Value
           ThisWorkbook.Sheets("Cible").Range("G" & i).Value = Workbooks(NomFichier).Sheets(1).Range("D5").Value
           ThisWorkbook.Sheets("Cible").Range("H" & i).Value = Workbooks(NomFichier).Sheets(1).Range("B8").Value
           ThisWorkbook.Sheets("Cible").Range("I" & i).Value = Workbooks(NomFichier).Sheets(1).Range("D8").Value
           ThisWorkbook.Sheets("Cible").Range("J" & i).Value = Workbooks(NomFichier).Sheets(1).Range("F18").Value
 
           Workbooks(NomFichier).Close
 
          End If
        NomFichier = Dir
    Loop
 
End Sub

J'espère que tu trouveras ton bonheur dans ce code.

Bonne journée.

[alucard_xs]

ok il me fait des trucs intéressants

merci