Bonjour !
J'espère que vous avez passé un bon week-end !
Je reviens vers vous car, débutant dans excel, je cherche à créer une macro afin de consolider plusieurs fichiers de différents dossiers, et après avoir cherché des informations à gauche à droite, je me retrouve avec les codes ci-dessous :
et
Ces macros ont pour objectif de sélectionner le contenu de la cellule f4 de chaque fichier dans le dossier spécifié manuellement et de les mettre en colonne.
Après pour être tout à fait honnête je n'en comprends pas les 3/4 mais j'essaye...
Mon but est de : Indiquer un chemin d'accès (ex : C:\Users\etn\Downloads\PRENOM) pour chaque macro (un différent pour chaque macro), à la place de les sélectionner manuellement.
Et dans un 2e temps qu'elles s'exécutent en même temps (plutôt que de les lancer une par une), et si possible les avoir sur une feuille différente.
J'espère avoir été clair et si vous avez la moindre questions n'hésitez pas je répondrai le plus rapidement possible.
Merci d'avance.
J'espère que vous avez passé un bon week-end !
Je reviens vers vous car, débutant dans excel, je cherche à créer une macro afin de consolider plusieurs fichiers de différents dossiers, et après avoir cherché des informations à gauche à droite, je me retrouve avec les codes ci-dessous :
Code:
Private Function ChoisirDossier() As String
Dim objShell
Dim objFolder
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
(&H0&, "Sélectionnez un Dossier", &H1&)
On Error GoTo Erreur
ChoisirDossier = objFolder.ParentFolder _
.ParseName(objFolder.Title).Path & ""
Exit Function
Erreur:
ChoisirDossier = ""
End Function
Sub PRENOM()
Dim FSO 'As Scripting.FileSystemObject
Dim SourceFolder 'As Scripting.Folder
Dim FileItem 'As Scripting.File
Dim chemin$
Dim T()
Dim cpt&
Dim g&
Dim i&
Dim j&
Dim Lig&
Dim var
Dim WB As Workbook
Dim S As Worksheet
Dim DEST As Worksheet
Dim Info(1 To 1, 1 To 26)
'------------
chemin$ = ChoisirDossier
If chemin$ = "" Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(chemin$)
If SourceFolder.Files.Count = 0 Then Exit Sub
For Each FileItem In SourceFolder.Files
If LCase(Right(FileItem.Name, 4)) = ".xls" Then
cpt& = cpt& + 1
ReDim Preserve T(1 To cpt&)
T(cpt&) = chemin$ & "\" & FileItem.Name
End If
Next FileItem
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
'------------
Application.ScreenUpdating = False
Set DEST = Sheets.Add
Lig& = 1
For g& = 1 To UBound(T)
Set WB = GetObject(T(g&))
Set S = WB.Sheets("PRENOM")
Info(1, 1) = S.Range("f4")
WB.Close
Set WB = Nothing
Lig& = Lig& + 1
DEST.Range(DEST.Cells(Lig&, 1), _
DEST.Cells(Lig&, UBound(Info, 2))) = Info
Erase Info
Next g&
var = Array("PRENOM")
With DEST
.Range(.Cells(1, 1), .Cells(1, UBound(var) + 1)) = var
.Range("a1").Interior.ColorIndex = 6
End With
Application.ScreenUpdating = False
Exit Sub
Erreur:
Application.ScreenUpdating = False
MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description
End Subet
Code:
Private Function ChoisirDossier() As String
Dim objShell
Dim objFolder
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
(&H0&, "Sélectionnez un Dossier", &H1&)
On Error GoTo Erreur
ChoisirDossier = objFolder.ParentFolder _
.ParseName(objFolder.Title).Path & ""
Exit Function
Erreur:
ChoisirDossier = ""
End Function
Sub NOM()
Dim FSO 'As Scripting.FileSystemObject
Dim SourceFolder 'As Scripting.Folder
Dim FileItem 'As Scripting.File
Dim chemin$
Dim T()
Dim cpt&
Dim g&
Dim i&
Dim j&
Dim Lig&
Dim var
Dim WB As Workbook
Dim S As Worksheet
Dim DEST As Worksheet
Dim Info(1 To 1, 1 To 26)
'------------
chemin$ = ChoisirDossier
If chemin$ = "" Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(chemin$)
If SourceFolder.Files.Count = 0 Then Exit Sub
For Each FileItem In SourceFolder.Files
If LCase(Right(FileItem.Name, 4)) = ".xls" Then
cpt& = cpt& + 1
ReDim Preserve T(1 To cpt&)
T(cpt&) = chemin$ & "\" & FileItem.Name
End If
Next FileItem
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
'------------
Application.ScreenUpdating = False
Set DEST = Sheets.Add
Lig& = 1
For g& = 1 To UBound(T)
Set WB = GetObject(T(g&))
Set S = WB.Sheets("NOM")
Info(1, 1) = S.Range("f4")
WB.Close
Set WB = Nothing
Lig& = Lig& + 1
DEST.Range(DEST.Cells(Lig&, 1), _
DEST.Cells(Lig&, UBound(Info, 2))) = Info
Erase Info
Next g&
var = Array("NOM")
With DEST
.Range(.Cells(1, 1), .Cells(1, UBound(var) + 1)) = var
.Range("a1").Interior.ColorIndex = 6
End With
Application.ScreenUpdating = False
Exit Sub
Erreur:
Application.ScreenUpdating = False
MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description
End SubCes macros ont pour objectif de sélectionner le contenu de la cellule f4 de chaque fichier dans le dossier spécifié manuellement et de les mettre en colonne.
Après pour être tout à fait honnête je n'en comprends pas les 3/4 mais j'essaye...
Mon but est de : Indiquer un chemin d'accès (ex : C:\Users\etn\Downloads\PRENOM) pour chaque macro (un différent pour chaque macro), à la place de les sélectionner manuellement.
Et dans un 2e temps qu'elles s'exécutent en même temps (plutôt que de les lancer une par une), et si possible les avoir sur une feuille différente.
J'espère avoir été clair et si vous avez la moindre questions n'hésitez pas je répondrai le plus rapidement possible.
Merci d'avance.