Discussion :

[nancy38]

Bonjour,

Je voudrais créer une macro qui ouvre tous les fichiers un par un dans un répertoire et ensuite une fois le 1er fichier ouvert, copie les données des cases A5 et B5 , les colle dans un autre fichier excel "BDD.xlsx" (déjà ouvert par l'utilisateur) ferme le fichier, ouvre le fichier suivant, copie les données des cases A5 et B5 les colle dans le fichier BDD.xlsx à la ligne suivante etc.

Je voudrais commencer par

Application.getopenfilename afin de ne pas figer ce répertoire dans la macro...

Je pense qu'il faut utiliser For 1 to ubound pour pouvoir traiter l'ensemble des fichiers dans le répertoire donné mais j'arrive pas à construire l'ensemble de la macro

Merci pour votre aide

[Invité]

Bonjour,
Test ç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
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
Dim ClasseurResultat As Workbook
Dim L_Cible As Long
 
Sub Scan()
 
Dim FSO
Dim RepRacine As String
 
Set ClasseurResultat = ActiveWorkbook
Set MyFeuilleResultat = ClasseurResultat.Worksheets(1)
L_Cible = MyFeuilleResultat.UsedRange.Rows.Count +1
RepRacine = ClasseurResultat.Path
If Right(RepRacine, 1) <> "\" Then RepRacine = RepRacine & "\"
Set FSO = CreateObject("Scripting.FileSystemObject")
 
'Je scan le répertoire source.
If FSO.FolderExists(RepRacine) Then
    Set Rep = FSO.GetFolder(RepRacine)
    Set ListFichiers = Rep.Files
    For Each MonFich In ListFichiers
       If InStr(1, UCase(MonFich.Name), ".XLS") <> 0 Then
'        Je traite le fichier.
        Traitement MonFich.Path
       End If
    Next
End If
MyFeuilleResultat.Cells.EntireColumn.AutoFit
End Sub
Sub Traitement(Fichier As String)
On Error Resume Next
Dim L As Long
Dim C As Long
Dim F As Long
Dim MyRange As Range
Dim MyExcel As Object
Set MyExcel = CreateObject("Excel.Application")
Dim MyClasseur As Workbook
MyExcel.Visible = True
Set MyClasseur = MyExcel.Workbooks.Open(Fichier) 'J'ouvre le fichier.
   Set MyRange = MyClasseur.Worksheets(1).Range("A5:B5")
 
            MyFeuilleResultat.Cells(L_Cible, 1) = MyRange(1, 1)
            MyFeuilleResultat.Cells(L_Cible, 2) = MyRange(1, 2)
 
        L_Cible = L_Cible + 1
 
 
MyClasseur.Close False
MyExcel.Quit
End Sub
Sub Entete(MyFeuille As Worksheet)
Dim col As Long
For col = 1 To Titre.Count
    MyFeuille.Cells(1, col) = Titre(col)
    MiseEnForm MyFeuille.Cells(1, col)
Next
End Sub
Sub MiseEnForm(MyRange As Range)
    With MyRange.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 0
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
   With MyRange.Font
        .Color = 16777215
        .TintAndShade = 0
    End With
End Sub

[Kimy_Ire]

Bonjour, je n'ai pas testé mais tu auras une idée de la façon d'ouvrir tous les classeurs d'un répertoire.

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
Sub ouvrir_fichiers()
 
ChDir "c:\test\"
monfichier = Dir("*.*")
 
i = 0
While monfichier <> ""
    Workbooks.Open monfichier
    i = i + 1
    With ActiveWorkbook
        For j = 0 To 1
            Workbooks("BDD").Worksheets("BDD_test").Range("A5").Offset(i, j) = .Range("A5").Offset(0, j)
        Next j
    End With
 
    monfichier = Dir()
Wend
 
End Sub

Tiens moi au courant !

[Invité]

Je le fais dans mon exemple.
Dir ne te donne que le nom du fichier

Code :

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

1
2
3
4
monfichier = Dir("c:\test\*.XLS")
 
While monfichier <> ""
	Workbooks.Open "c:\test\" & monfichier

[nancy38]

Merci à tous les 2 mais quand je lance la 1ere il y a rien comme résultat au final et la 2ème j'arrive pas à l'adapter comme il faut pour que ca fontionne (j'ai une erreur au niveau de la ligne 9)... je continue dans mes recherches et je vous tiens au courant


Merci encore une fois pour vos efforts

[Kimy_Ire]

Si tu as "Option Explicit", il suffit de déclarer le "i" comme integer.

Code :

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

Dim i As Integer