Sub Consolide()
Dim a, w As Worksheet, chemin$, fichier$, n%
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
'---suppression des feuilles---
a = Array("Feuil1", "Feuil2") 'tableau des CodeNames des feuilles à conserver
For Each w In Worksheets
If IsError(Application.Match(w.CodeName, a, 0)) Then w.Delete
Next
'---création des onglets---
'chemin = "Y:\I&P-Domaine-Serveur-Stockage\Pole_Standardisation\Projet inventaire\Outils_Inventaire_VM\RVTools\Rapports\Rapports\"
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xls")
While fichier <> ""
If fichier <> ThisWorkbook.Name Then
With Workbooks.Open(chemin & fichier)
With .Sheets("Dépenses")
.Visible = xlSheetVisible 'si la feuille est masquée
n = ThisWorkbook.Sheets.Count
.Copy After:=ThisWorkbook.Sheets(n)
With ThisWorkbook.Sheets(n + 1)
.Name = Left(.[C3], 31)
.DrawingObjects.Delete 'suppression des objets
With .Parent.VBProject.VBComponents(.CodeName).CodeModule
.DeleteLines 1, .CountOfLines 'suppression du code VBA
End With
End With
End With
.Close
End With
End If
fichier = Dir
Wend
Feuil1.Activate
End Sub