Bonjour le forum,
Je souhaite réutiliser une ancienne macro créé sous excel 2003 mais la ligne Set fs = Application.FileSearch bloque.
Savez vous comment je peux contourner ce problème ?
Je vous mets la macro qui sert à consolider plusieurs fichier.
Merci d'avance
Je souhaite réutiliser une ancienne macro créé sous excel 2003 mais la ligne Set fs = Application.FileSearch bloque.
Savez vous comment je peux contourner ce problème ?
Je vous mets la macro qui sert à consolider plusieurs fichier.
Merci d'avance
Code:
Sub consolidationFichiers()
Dim f, nbFeuilles As Integer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
thisBookName = ActiveWorkbook.Name
Sheets(configSheet).Activate
relPath = Cells(2, 2)
dataSheetName = Cells(3, 2)
titleRange = Cells(4, 2)
consolidTitle = Cells(5, 2)
consolidTabs = (Cells(6, 2) = "1")
triPrealable = Cells(7, 2)
Sheets(consolidationSheet).Cells.Delete Shift:=xlUp
rowOffset = 0
currRow = 1
cf = 0
Sheets(consolidationSheet).Cells(currRow, 1) = "Nom Fichier sans Extension"
Set fs = Application.FileSearch
fp = ActiveWorkbook.path & "\" & relPath
fs.LookIn = fp
fs.Filename = "*.xls"
If fs.Execute > 0 Then
MsgBox fs.FoundFiles.Count & " Fichier(s) ont été trouvés."
NbFiles = fs.FoundFiles.Count
Application.StatusBar = "0 % réalisé."
For i = 1 To NbFiles
fn = fs.FoundFiles(i)
If fn <> ActiveWorkbook.path & "\" & ActiveWorkbook.Name Then
' MsgBox "Fichier " & i & ": " & fn
Workbooks.Open Filename:=fn
tempBookName = ActiveWorkbook.Name
If consolidTabs Then
nbFeuilles = ActiveWorkbook.Sheets.Count
For f = 1 To nbFeuilles
Workbooks(tempBookName).Activate
ActiveWorkbook.Sheets(f).Activate
consolideTab
Next f
Else
If dataSheetName <> "" Then
Sheets(dataSheetName).Activate
End If
consolideTab
End If
Workbooks(tempBookName).Close
End If
' Maj Bar de Progression
percentDone = 100 * (i / NbFiles)
If percentDone <> lastPercentDone Then
Application.StatusBar = percentDone & " % réalisé."
lastPercentDone = percentDone
End If
Next i
Else
MsgBox "Aucun fichier trouvé dans " & fp
End If
Beep
Application.StatusBar = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub