VBA - Parcourir dossiers et ouvrir fichier excel particulier

[Pournin]

Bonjour à tous.

Cela fait maintenant un moment que je ne parviens pas à réaliser la macro que j'aimerais créer. J'en ai réalisé une mais elle ne fonctionne pas (voir plus bas). La macro que j'aimerais créer aurait la fonction suivante:

Il existe un répertoire (SharePoint mais c'est un détail) composé de plusieurs dossiers. Dans chaque dossiers se trouve plusieurs fichiers dont un fichier excel dont le nom commence par "SIMULATION_". La macro vient ouvrir dans chacun des dossier du SharePoint, ce fichier excel. Ensuite j'éxécute plusieurs instructions qui me permettent de copier/coller certaines données de ces fichiers excel pour les rassembler dans un fichier excel global où la macro se trouve.

Voici la macro que j'ai réalisé mais qui bloque avec une erreur de type 91 Variable non définie ou variable de bloc with non définie à l'instruction soulignée. Je pense que c'est parce que je lui demande d'ouvrir une variable qui est un "Object" et non un "Workbook". Le souci est que j'utilise derrière une boucle "For each" avec cette même variable, et cette boucle ne fonctionnera pas avec une variable du type "Workbook".

Voici la macro:

Dim i As Long

Sub Consolider_Simu()
Dim S_Commande As Worksheet
Dim Chemin As String
Dim Extension As String

Set S_Commande = ThisWorkbook.Sheets("Commande")
Chemin = S_Commande.Cells(3, 2).Value
Extension = S_Commande.Cells(4, 2).Value
i = 6

Nb = BoucleFichiers(Chemin, Extension)

End Sub

Function BoucleFichiers(Chemin As String, Extension As String) As Integer
Dim Fso As Object
Dim Dossier As Object
Dim Fichier As Object
Dim WB_TargetFichier As Workbook
Dim TargetSheet As Worksheet
Dim MainSheet As Worksheet

Set Fso = CreateObject("Scripting.FileSystemObject")
Set WB_TargetFichier = Workbooks.Open(Fichier)
Set TargetSheet = WB_TargetFichier.Sheets("SIMULATION")
Set MainSheet = ThisWorkbook.Sheets("Main")
BoucleFichiers = 0

For Each Dossier In Fso.GetFolder(Chemin).SubFolders
For Each Fichier In Dossier.Files

If Fichier = "SIMULATION_" & "*" Then

TargetSheet.Range("F6:G13").Select
Selection.Copy
MainSheet.Range("D" & i).PasteSpecial Paste:=xlPasteValues
MainSheet.Range("D" & i).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
i = i + 22
BoucleFichiers = BoucleFichiers + 1

WB_TargetFichier.Close savechanges:=False

Else: i = i + 22
End If

Next Fichier
Next Dossier
End Function


J'apprécierais vraiment l'aide de l'un d'entre vous, je n'ai pas réussi à en trouver ailleurs, et internet ne m'a pas permis jusqu'à présent d'avancer dans la résolution de mon problème.

Bon après-midi à tous,

SkillzZ

 

[PMO2]

Bonjour,
Peut être comme ce qui suit

Function BoucleFichiers(Chemin As String, Extension As String) As Integer
Dim Fso As Object
Dim Dossier As Object
Dim Fichier As Object
Dim WB_TargetFichier As Workbook
Dim TargetSheet As Worksheet
Dim MainSheet As Worksheet

Set Fso = CreateObject("Scripting.FileSystemObject")
Set MainSheet = ThisWorkbook.Sheets("Main")
BoucleFichiers = 0
For Each Dossier In Fso.GetFolder(Chemin).SubFolders
  For Each Fichier In Dossier.Files
    If Fichier = "SIMULATION_" & "*" Then
   
      '/// modif pmo
      On Error Resume Next
      Err Clear
      Set WB_TargetFichier = Workbooks.Open(Fichier)
      Set TargetSheet = WB_TargetFichier.Sheets("SIMULATION")
      If Err = 0 Then
        TargetSheet.Range("F6:G13").Select
        Selection.Copy
        MainSheet.Range("D" & i).PasteSpecial Paste:=xlPasteValues
        MainSheet.Range("D" & i).PasteSpecial Paste:=xlPasteFormats
        Application.CutCopyMode = False
        i = i + 22
        BoucleFichiers = BoucleFichiers + 1
        WB_TargetFichier.Close savechanges:=False
      End If
      '///
   
    Else: i = i + 22
    End If
  Next Fichier
Next Dossier
End Function

 

[job75]

Bonjour Pournin, Patrick, le forum,

Ce code fonctionne bien si les cellules B3 et B4 de la feuille "Commande" sont renseignées correctement :

Dim i As Long

Sub Consolider_Simu()
Dim S_Commande As Worksheet
Dim Chemin As String
Dim Extension As String
Dim Nb As Integer

Set S_Commande = ThisWorkbook.Sheets("Commande")
Chemin = S_Commande.[B3]
Extension = S_Commande.[B4]
i = 6

Nb = BoucleFichiers(Chemin, Extension)
MsgBox Nb & " fichier(s) copié(s)"

End Sub

Function BoucleFichiers(Chemin As String, Extension As String) As Integer
Dim Fso As Object
Dim Dossier As Object
Dim Fichier As Object
Dim WB_TargetFichier As Workbook
Dim TargetSheet As Worksheet
Dim MainSheet As Worksheet

Set Fso = CreateObject("Scripting.FileSystemObject")
Set MainSheet = ThisWorkbook.Sheets("Main")

For Each Dossier In Fso.GetFolder(Chemin).SubFolders
For Each Fichier In Dossier.Files

If Fichier.Name Like "SIMULATION_" & "*" & Extension Then
Application.ScreenUpdating = False

Set WB_TargetFichier = Workbooks.Open(Fichier)
Set TargetSheet = WB_TargetFichier.Sheets("SIMULATION")

TargetSheet.Range("F6:G13").Copy
MainSheet.Range("D" & i).PasteSpecial Paste:=xlPasteValues
MainSheet.Range("D" & i).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
i = i + 22
BoucleFichiers = BoucleFichiers + 1

WB_TargetFichier.Close savechanges:=False

End If

Next Fichier
Next Dossier
End Function

Bonne journée.