Bug d'un Loop sur traitement de plusieurs fichiers
Bonjour,
J'ai créé une macro afin de récupérer des informations dans plusieurs fichiers d'un même dossier.
La macro tourne correctement mais bloque à partir du 16ème fichier à traiter, qui pourtant est au même format que les autres :roll:
Des idées des ce qui bug ( Le Débogueur affiche le bug à la ligne 31 sur Workbooks.Open fichier.Path 'ouvrons le fichier' ) et comment arranger cela ? merci par avance :D
Code:
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
|
Sub Conso_()
'
Application.ScreenUpdating = False
Sheets("Feuil1").Cells.ClearContents
' Conso_ Macro
'
Dim appXL As Object
Dim fso As Scripting.FileSystemObject
Dim dossier As Scripting.Folder
Dim fichier As Scripting.File
Dim wbsource As Workbook
Dim ldest As Long
Dim lsource As Long, ncol As Long
Dim src As Worksheet, dst As Worksheet, tmp As Worksheet
Dim test As String
Set fso = New Scripting.FileSystemObject
Set dossier = fso.GetFolder("D:\XXXXXXXXX")
Set dst = ThisWorkbook.Sheets("Feuil1")
Set tmp = ThisWorkbook.Sheets("temp")
ldest = 1
For Each fichier In dossier.Files
If Right(fichier.Name, 5) = ".xlsx" Or Right(fichier.Name, 4) = ".xls" Then
Workbooks.Open fichier.Path 'ouvrons le fichier'
Set wbsource = Workbooks(fichier.Name)
Set src = wbsource.Sheets("DB")
src.Range("A1:AI361").Copy tmp.Range("A1:AI361")
For lsource = 2 To 361
For ncol = 1 To 35
dst.Cells(ldest, ncol) = tmp.Cells(lsource, ncol)
Next
ldest = ldest + 1
Next
wbsource.Close savechanges:=False
End If
Next
Application.ScreenUpdating = True
End Sub |
