Bonjour,

Je souhaite rappatrier des fichiers excels dans un même fichier en fonction de leur nom, ici "fichier1" et "fichier2" :


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
 
Option explicit
 
Sub GetSheets()
 
Dim Path
Dim Filename
Dim Sheet
 
Dim d As Object
Dim x As String
 
Set d = CreateObject("Scripting.Dictionary")
'Ajout des clés, valeurs
d.Add "Fichier1.xlsx", ""
d.Add "Fichier2.xlsx", ""
 
 
Path = "C:\Mes documents\"
Filename = Dir(Path & "*.xlsx")
While Filename <> ""
    If d.exists(Filename) Then
        Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
 
        For Each Sheet In ActiveWorkbook.Sheets
            Sheet.Copy After:=ThisWorkbook.Sheets(1)
        Next Sheet
 
        Workbooks(Filename).Close
        Filename = Dir()
    End If
Wend
 
End Sub
La macro rappatrie correctement "fichier1" et "fichier2", mais bug au "End If" lorsqu'elle essaie de rapatrier un fichier qui n'appartient pas au dictionnaire d.

Je vous remercie de votre aide.

Cordialement,