EXCEL: Macro Gestion Donnees

Sub arborescenceRepertoire()
  racine = ChoixDossier()
  If racine = "" Then Exit Sub
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier_racine = fs.getfolder(racine)
  Lit_dossier dossier_racine, 1
End Sub
Sub Lit_dossier(ByRef dossier, ByVal niveau)
   For Each f In dossier.Files
'ICI se joue tout!!!
'Si le nom du fichier contient "frais" alors on a un message qui nous donne son nom
        If f.Name Like "*frais*" Then MsgBox f.Name
   Next
   For Each d In dossier.SubFolders
     Lit_dossier d, niveau + 1
   Next
End Sub
Function ChoixDossier()
    If Val(Application.Version) >= 10 Then
       With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ActiveWorkbook.Path & "\"
        .Show
        If .SelectedItems.Count > 0 Then
           ChoixDossier = .SelectedItems(1)
        Else
           ChoixDossier = ""
        End If
       End With
     Else
       ChoixDossier = InputBox("Répertoire?")
     End If
End Function

If f.Name Like "*Classeur*" And Left(Split(f.Name, ".")(1), 3) = "xls"

If Left(Split(f.Name, ".")(1), 3) = "xls" Then
     If f.Name Like "*insurance*" Or   f.Name Like "*customer*" Then
        ReDim Preserve RepFich(1 To 2, 1 To i)
        RepFich(1, i) = dossier
        RepFich(2, i) = f.Name
        i = i + 1
     End If
End If

If Feuille.Name <> "Feuil2" Then Feuille.Copy after:=WbkRecap.Worksheets(WbkRecap.Worksheets.Count)

If Feuille.Name = "Global" Or Feuille.Name = "Sheet1" Then Feuille.Copy after:=WbkRecap.Worksheets(WbkRecap.Worksheets.Count)

Range("C:C,D:D,E:E,G:G,J:J,K:K,Q:Q,R:R").Delete Shift:=xlToLeft

Dim Feuille As WorkSheet
Application.ScreenUpdating = False
For Each Feuille In ThisWorkBook.WorkSheets
    If Feuille.Name <> "Feuil1" Then
        With Feuille
            .Range("C:C,D:D,E:E,G:G,J:J,K:K,Q:Q,R:R").Delete Shift:=xlToLeft
        End With
    End If
Next
Application.ScreenUpdating = True

.Columns("H:H").Cut
.Columns("D:D").Insert Shift:=xlToRight

Sub ArrangeColonnes()
Dim Feuille As WorkSheet

For Each Feuille In ThisWorkBook.WorkSheets
    If Feuille.Name <> "Feuil1" Then
        With Feuille
            .Range("C:C,D:D,E:E,G:G,J:J,K:K,Q:Q,R:R").Delete Shift:=xlToLeft
            .Columns("H:H").Cut
            .Columns("D:D").Insert Shift:=xlToRight
        End With
    End If
Next
End Sub

Sub MainProcedure()
Dim racine As String
Dim fs As Object, dossier_racine As Object

  racine = ChoixDossier()
  If racine = "" Then Exit Sub
  i = 1
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier_racine = fs.getfolder(racine)
  Lit_dossier dossier_racine
  ImportDonnees
  ArrangeColonnes
End Sub

Option Explicit

Dim RepFich() As String
Dim i As Integer

Sub MainProcedure()
Dim racine As String
Dim fs As Object, dossier_racine As Object

  racine = ChoixDossier()
  If racine = "" Then Exit Sub
  i = 1
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier_racine = fs.getfolder(racine)
  Lit_dossier dossier_racine
  ImportDonnees
End Sub

Sub Lit_dossier(ByRef dossier)
Dim f, d

For Each f In dossier.Files
    If f.Name Like "*Classeur*" And Left(Split(f.Name, ".")(1), 3) = "xls" Then
        ReDim Preserve RepFich(1 To 2, 1 To i)
        RepFich(1, i) = dossier
        RepFich(2, i) = f.Name
        i = i + 1
    End If
Next
For Each d In dossier.SubFolders
    Lit_dossier d
Next
End Sub

Sub ImportDonnees()
Dim WbkRecap As Workbook, WbkSource As Workbook
Dim Feuille As Worksheet

Set WbkRecap = ThisWorkbook
Application.ScreenUpdating = False
For i = LBound(RepFich, 2) To UBound(RepFich, 2)
    Set WbkSource = Workbooks.Open(RepFich(1, i) & "\" & RepFich(2, i))
    For Each Feuille In WbkSource.Worksheets
        If Feuille.Name <> "Feuil2" Then Feuille.Copy after:=WbkRecap.Worksheets(WbkRecap.Worksheets.Count)
    Next Feuille
    Application.DisplayAlerts = False
    WbkSource.Close
    Application.DisplayAlerts = True
Next i
Application.ScreenUpdating = True
Set WbkRecap = Nothing
Set WbkSource = Nothing
End Sub

Function ChoixDossier()
If Val(Application.Version) >= 10 Then
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ActiveWorkbook.Path & "\"
        .Show
        If .SelectedItems.Count > 0 Then
            ChoixDossier = .SelectedItems(1)
        Else
            ChoixDossier = ""
        End If
    End With
Else
    ChoixDossier = InputBox("Répertoire?")
End If
End Function