Sub Ouvrir_Fichiers()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False


'Permet d'ouvrir plusieurs fichiers dans un répertoire
Dim fichierinfoligne As Workbook, fichierdemesure As Workbook
Dim dossier As String, monfichier As String
Dim i As Integer
Dim numPylfichierinfoligne As String
Dim nomlitfichiermesure As String
Dim numPylfichierdemesure As String
Dim plagederecherche As Range
Dim champsIL As Worksheet
Dim typedefichier As String


Dim a As Integer

Dim f As Integer
Dim fichier As String

Dim Fso As Object
Dim f1 As Object, f2 As Object


Dim numdelignePyl As String
Dim numdeligne As Variant

Static Rmes As Variant
Dim RayEq As Variant
Dim ResSol As Variant
Dim RAxe1a As Variant
Dim RAxe1b As Variant
Dim RAxe1c As Variant
Dim RAxe2a As Variant
Dim RAxe2b As Variant
Dim RAxe2c As Variant

Dim dat As Variant

Dim trouvee As Object
Dim validationfichier As String

MacroDebut = Now

Set fichierinfoligne = ThisWorkbook

Set Fso = CreateObject("Scripting.FileSystemObject")

'dossier = "\\bureau.si.interne\DATA\GT1LI\EchangeSITE\GT1LI\POLITIQUE MC2\04 Etudes\"
dossier = "D:\Users\timitenam\Desktop\test\"

monfichier = Dir(dossier) 'tous les fichiers de mon dossier
Application.ScreenUpdating = False
f = FreeFile
    
'Set plagederecherche = ActiveSheet.Columns(5) 'j'aaffecte la colonne 5 de mon fichier actif à plage de recherche
   
    
        For Each f1 In Fso.GetFolder(dossier).SubFolders 'je parcours tous les dossiers qui se trouvent dans mon chemin
              For Each f2 In f1.Files 'je parcours ous les fichiers de chaque dossier
            
                 If InStr(Right(f2.Name, 5), ".xls") <> 0 Then   'je teste les extensions de mes fichiers
                
                 If Left(f2.Name, 3) = "MES" Or Left(f2.Name, 3) = "ME_" Or Left(f2.Name, 3) = "Me_" Or Left(f2.Name, 3) = "Mes" Then 'je teste les noms de mes fichiers
                 
                 
                 Set fichierdemesure = Workbooks.Open(f2)           'Ouvre le fichier excel
            
                    a = fichierdemesure.Sheets(1).Range("B7").Value
                    fichierdemesure.Sheets(1).Range("B7").Value = a
                        
                    With ActiveWorkbook
                                     typedefichier = fichierdemesure.Sheets(1).Range("B2").Value 'je teste le type du fichier grace à la colonne B2
                                    
                                     Select Case typedefichier
                                     Case Is > 0
                                     
                                     Rmes = fichierdemesure.Sheets(1).Range("B10").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     RayEq = fichierdemesure.Sheets(1).Range("B25").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     ResSol = fichierdemesure.Sheets(1).Range("B26").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     dat = fichierdemesure.Sheets(1).Range("K4").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     
                                     RAxe1a = fichierdemesure.Sheets(1).Range("I25").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     RAxe1b = fichierdemesure.Sheets(1).Range("J25").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     RAxe1c = fichierdemesure.Sheets(1).Range("K25").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     
                                     RAxe2a = fichierdemesure.Sheets(1).Range("I27").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     RAxe2b = fichierdemesure.Sheets(1).Range("J27").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     RAxe2c = fichierdemesure.Sheets(1).Range("K27").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     
                                     Case Is < 0
                                     Rmes = fichierdemesure.Sheets(1).Range("B7").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     RayEq = fichierdemesure.Sheets(1).Range("B20").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     ResSol = fichierdemesure.Sheets(1).Range("B21").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     dat = fichierdemesure.Sheets(1).Range("K3").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     
                                     RAxe1a = fichierdemesure.Sheets(1).Range("I20").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     RAxe1b = fichierdemesure.Sheets(1).Range("J20").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     RAxe1c = fichierdemesure.Sheets(1).Range("K20").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     
                                     RAxe2a = fichierdemesure.Sheets(1).Range("I22").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     RAxe2b = fichierdemesure.Sheets(1).Range("J22").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     RAxe2c = fichierdemesure.Sheets(1).Range("K22").Value  'on selectionne la valeur de la resistance dans fichierdemesure
                                     
                                     End Select
                        End With
                    
        
                    
                   
                    nomlitfichiermesure = Split(f1.Name, "_")(1)    'on recupère le extension de lit dans le fichierdemesure
                    numPylfichierdemesure = Mid(Split(f1.Name, "_")(2), 5, 3) 'on recupère le num du pyl dans le fichierdemesure
                    fichierinfoligne.Sheets("ChampsIL").Activate
                    
                    With ActiveWorkbook  'je travaille dans le classeur actif
                    'With Worksheets("ChampsIL").Range("E1:E28242")

                    Set plagederecherche = ActiveSheet.Columns(5)
                   ' trouvee = 0
                    'Set trouvee = .Find(nomlitfichiermesure, LookIn:=xlValues)
                    Set trouvee = plagederecherche.Cells.Find(what:=nomlitfichiermesure, LookAt:=xlWhole) 'je cherche le premier numero de ligne qui correspond au nom delit de mon fichier de mesure qui a été ouvert
                        If Not trouvee Is Nothing Then
                             numdeligne = trouvee.Row  'je recupère le numero de ligne de mon
                             numdelignePyl = 0
                                For i = numdeligne To 28242
                                a = fichierinfoligne.Sheets("ChampsIL").Cells(i, 6)
                                    If numPylfichierdemesure = a Then
                                     numdelignePyl = i: Exit For
                                    End If
                                     
                                Next
                                If numdelignePyl <> 0 Then
                                            If fichierinfoligne.Sheets("ChampsIL").Cells(numdelignePyl, 5) = nomlitfichiermesure Then
                                                fichierinfoligne.Sheets("ChampsIL").Cells(numdelignePyl, 15) = Rmes
                                                fichierinfoligne.Sheets("ChampsIL").Cells(numdelignePyl, 16) = RayEq
                                                fichierinfoligne.Sheets("ChampsIL").Cells(numdelignePyl, 17) = ResSol
                                                
                                                fichierinfoligne.Sheets("ChampsIL").Cells(numdelignePyl, 23) = RAxe1a
                                                fichierinfoligne.Sheets("ChampsIL").Cells(numdelignePyl, 24) = RAxe1b
                                                fichierinfoligne.Sheets("ChampsIL").Cells(numdelignePyl, 25) = RAxe1c
                                                
                                                fichierinfoligne.Sheets("ChampsIL").Cells(numdelignePyl, 26) = RAxe2a
                                                fichierinfoligne.Sheets("ChampsIL").Cells(numdelignePyl, 27) = RAxe2b
                                                fichierinfoligne.Sheets("ChampsIL").Cells(numdelignePyl, 28) = RAxe2c
                                                
                                                monfichier = ActiveWorkbook.Name
                                                
                                                fichier = "D:\Users\timitenam\Desktop\fichierscopies"
                                                Open fichier For Append As f
                                                Print #f, dossier + f2.Name
                                                Close #f
                                                
                                             Else
                    
                                                fichier = "D:\Users\timitenam\Desktop\PastrouvenumPyl"
                                            
                                                Open fichier For Append As f
                                                Print #f, dossier + f2.Name
                                                Close #f
                                            End If
                                End If
                        
                        End If
                    
                   ' fichier = "D:\Users\timitenam\Desktop\Pastrouve"
                            
                    '            Open fichier For Append As f
                     '           Print #f, dossier + f2.Name
                      '          Close #f
                End With
                   
                              
                     fichierdemesure.Close False   'Fermer le fichier
                     monfichier = Dir("")  'on prend un nouveau fichier
             End If

             End If
               
               
                 
            Next f2
            fichier = "D:\Users\timitenam\Desktop\Pastrouve"
                            
                                Open fichier For Append As f
                                Print #f, dossier + f1.Name
                                Close #f
                     
        Next f1
            
Set fichierinfoligne = Nothing
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.ScreenUpdating = True

MsgBox "Tout a été extrait"
MsgBox "Durée d'exécution: " & Format(Now - MacroDebut, "hh:mm:ss")

End Sub

Bonjour,

Je dois réaliser un programme vba et je débute avec vba , j'ai donc quelques difficultés.

J'utilise VBA pour aller parcourir plusieurs fichiers Excel qui se trouvent dans plusieurs sous-dossiers sur mon bureau et ensuite je récupère des valeurs dans chaque fichier Excel pour aller remplir un autre fichier Excel unique.

Plus clairement j'ai un dossier qui se nomme dossier MC2 à l'intérieur duquel se trouve plusieurs sous dossiers. Les sous dossiers sont nommée de la façon suivante MC2_nom_num. Ensuite, dans chaque sous-dossier on retrouve un fichier Excel qui est nommé sous la forme ME_nom_num et d'autres types de fichiers.

Mon programme doit parcourir tous les sous-dossiers et ensuite ouvrir uniquement les fichiers excels. Lorsqu'il ouvre un fichier excel, il doit récupérer plusieurs données que je stocke dans des variables Rmes, RayEq etc..

J'ai un deuxième fichier Excel qu'on va appeler fichierinfoligne ( il fait 28000 ++ lignes) que je dois approvisionner avec les valeurs Rmes, RayEq.. en fonction du nom et du num que j'aurai extrait sur le nom de mon sous-dossier plus haut. Je vais regarder dans mon fichierinfoligne la ligne qui correspond au nom et au num de mon dossier et ensuite je remplis les colonnes correspondantes avec les valeurs de Rmes, RayEq etc...

Cependant je rencontre quelques soucis,

1- Mon programme n'arrive pas à récupérer les valeurs dans tous les fichiers excels MC2  qu'ils ouvrent et les stocker dans les variables que j'ai définie

2- Du coup , conséquence du premier problème c'est que dans mon fichier infoligne j'arrive pas à tout remplir vu que mes variables sont vides.

3- Mon programme mets plus d'1 heures de temps de l'exécution jusqu'à la fin

Merci d'avance pour l'aide que vous m'apporteriez

Bonjour,

Déplacement vers un forum plus approprié

Le sujet est déplacé de la section Langages.NET vers la section Autres langages (VBA, Ruby,...)

Est-ce que tu arrives à trouver tous tes fichiers ? (je pense que j'aurai utilisé 2 boucles avec Dir, la première pour parcourir les dossier (dir(chemin,vbdirectory)) et un autre pour les fichiers (dir(chemin,"ME*.xls*")) pour ne récupérer que les fichiers excel commençant par ME (quelque soit la casse, windows se moquant de la casse dans le nom des fichiers/dossiers)

En fait, tu utilises 2 méthodes différentes et non liés pour parcourir tes dossiers, pas forcément sûr que le fichier récupéré par dir soit le même que celui par le fso

Evite le ActiveWorkbook quand tu as plusieurs fichiers classeurs, indique le classeur cible, c'est plus sûr pour taper dans le bon classeur (d'autant que le with ActiveWorkbook ne te sers à rien ici et tu ne t'en sers pas en ligne 76)

à quoi servent les lignes 73 et 74 ?

pour la boucle à la ligne 129, pourquoi tu n'utilises pas la fonction Find sur la colonne 6 ? tu récupèrerais la ligne voulue comme tu le fais au dessus