regrouper des données de plusieurs fichiers (macros?)

[ZZoé]

Bonjour!

Je me suis engagée à faire une analyse statistique des "compétences managériales" dévelopées par les étudiants de mon école pendant leurs stages. Je maîtrise à peu près les logiciels statistiques comme Modalisa et Sphinx, mais pas tellement Excel...

Or les étudiants ont répondu aux questions sur des fichiers Excel. J'ai donc 421 fichiers Excel qui correspondent chacun à une personne. Et dans chaque fichier, il y a plusieurs feuilles, dont une qui m'intéresse particulièrement parce qu'il y a un tableau avec les données qu'il me faut.

Le tableau est de cette forme:
- en intitulé de colonne: le secteur et la fonction du stage, les différentes compétences
- deux lignes: une pour l'auto-évaluation de l'étudiant par rapport aux compétences (note de 1 à 10) et l'autre pour l'évaluation de l'entreprise.

J'aurais besoin d'avoir ces données (de tous les étudiants) sur une seule feuille et dans un seul tableau avec en intitulé de colonne: les compétences évaluées par l'étudiant et par l'entreprise, le secteur et la fonction du stage, pour pouvoir ensuite importer ce tableau dans le logiciel de statistiques Sphinx.

On m'a dit qu'il fallait utiliser des "macros"... mais je ne sais pas ce que ça veut dire et encore moins comment les utiliser! Je pourrais faire des copier-coller des 421 tableaux (ça je sais faire!), mais ça prendrait un temps fou!

Toute aide serait la TRES bienvenue...!

Merci d'avance,

Zoé

 

[PMO2]

Re : regrouper des données de plusieurs fichiers (macros?)

Bonjour,

Je me suis référé totalement aux pièces que vous avez fournies.
J'ai donc considéré que seule la première feuille de chaque classeur est à regrouper.


1) Créez un dossier et renommez du nom que vous voulez. Mettez y les classeurs concernés à agréger.
Mettez ce dossier dans le disque C (ou D ou autre mais par sur le Bureau pour raisons techniques).
2) Copiez le code suivant dans un module standard d'un nouveau classeur.
Ce classeur ne doit pas être contenu dans le dossier précédemment créé.

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 GrouperDataFichiers()
Dim FSO 'As Scripting.FileSystemObject
Dim SourceFolder 'As Scripting.Folder
Dim FileItem 'As Scripting.File
Dim chemin$
Dim T()
Dim cpt&
Dim g&
Dim Lig&
Dim LastLig&
Dim WB As Workbook
Dim S As Worksheet
Dim DEST As Worksheet
Dim R As Range
'------------
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(1)
  If g& = 1 Then
    Set R = S.Range("a1:k1")
    R.Copy Destination:=DEST.Range("a1")
    Lig& = 2
  End If
  LastLig& = S.[a1].CurrentRegion.Rows.Count
  If Lig& - 1 + LastLig& >= 65536 Then
    MsgBox "Capacité de 65536 lignes d'Excel dépassée."
    WB.Close
    Set WB = Nothing
    Exit Sub
  End If
  Set R = S.Range("a2:k" & LastLig& & "")
  R.Copy Destination:=DEST.Range("a" & Lig&)
  Lig& = Lig& + LastLig& - 1
  WB.Close
  Set WB = Nothing
Next g&
Application.ScreenUpdating = False
Exit Sub
Erreur:
Application.ScreenUpdating = False
MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description
End Sub

Il n'y a plus qu'à lancer la macro GrouperDataFichiers. Le regroupement apparaîtra dans une nouvelle feuille.

Cordialement.

PMO
Patrick Morange

 

[muirdhin]

Re : regrouper des données de plusieurs fichiers (macros?)

Bonjour,

Merci beaucoup, tout marche parfaitement bien ! La Macro correspond parfaitement au besoin
Je vais pouvoir agréger tous mes fichiers en évitant beaucoup d'opérations fastidieuses.

Bonne continuation

Muirdhin

 

[Sareraka]

Re : regrouper des données de plusieurs fichiers (macros?)

Bonjour,
Merci beaucoup à tous ceux qui ont participés à ce sujet car j'ai trouvé ici (dans le macroGrouperDataFichiers de Patrick Morange) une grand partie de ce que voudrais faire.
J'ai juste une petite demande:
Est ce qu'il est possible d'ajouter dans le macroGrouperDataFichiers dessus un code pour que le nom du fichier source soit mis dans la première colonne (ou dernière colonne) du fichier final pour chaque ligne copier? En pièce jointe les exemples des fichiers sources et fichier cible.
Encore tous mes remerciement,

Sareraka

 

[PMO2]

Re : regrouper des données de plusieurs fichiers (macros?)

Bonjour,

Voyez avec ce code modifié (les ajouts et modifications sont signalés par des ///)

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 GrouperDataFichiers()
Dim FSO 'As Scripting.FileSystemObject
Dim SourceFolder 'As Scripting.Folder
Dim FileItem 'As Scripting.File
Dim chemin$
Dim T()
Dim cpt&
Dim g&
Dim Lig&
Dim LastLig&
Dim WB As Workbook
Dim S As Worksheet
Dim DEST As Worksheet
Dim R As Range
Dim NomFichier$  '///
'------------
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&))
  NomFichier$ = WB.Name   '///
  Set S = WB.Sheets(1)
  If g& = 1 Then
    Set R = S.Range("a1:k1")
    R.Copy Destination:=DEST.Range("b1")  '///
    DEST.[a1] = NomFichier$               '///
    Lig& = 2
  End If
  LastLig& = S.[a1].CurrentRegion.Rows.Count
  If Lig& - 1 + LastLig& >= Application.Rows.Count Then
    MsgBox "Capacité de " & Application.Rows.Count & " lignes d'Excel dépassée."
    WB.Close
    Set WB = Nothing
    Exit Sub
  End If
  Set R = S.Range("a2:k" & LastLig& & "")
  R.Copy Destination:=DEST.Range("b" & Lig&)  '///
  DEST.Range("a" & Lig& & ":a" & DEST.[b1].CurrentRegion.Rows.Count & "") = NomFichier$ '///
  Lig& = Lig& + LastLig& - 1
  WB.Close
  Set WB = Nothing
Next g&
Application.ScreenUpdating = True
Exit Sub
Erreur:
Application.ScreenUpdating = True
MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description
End Sub

 

[Etn]

Re : regrouper des données de plusieurs fichiers (macros?)

Bonjour,

Je me suis également servi de ce code pour consolider mes fichiers et j'ai (avec l'aide de quelques personnes) fini par arrivé à ce code qui fonctionne :

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$ = "C:\Downloads"
 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" Or LCase(Right(FileItem.Name, 5)) = ".xlsx" Or LCase(Right(FileItem.Name, 5)) = ".xlsm" 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 = Workbooks.Open(Filename:=T(g&), ReadOnly:=True, UpdateLinks:=0)
   Set S = WB.Sheets("NOM")
   Info(1, 1) = S.Range("c1")
   WB.Close False
   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 Sub

Je souhaiterais savoir s'il était possible de mettre en nom de feuille le contenu de la cellule A1 (donc le nom de la variante).

Cordialement,

Etn

 

[thebenoit59]

Re : regrouper des données de plusieurs fichiers (macros?)

Je n'ai pas tout suivi, mais tu peux partir sur ce principe : ActiveSheet.Name = Range("A1").Value

 

[thebenoit59]

Re : regrouper des données de plusieurs fichiers (macros?)

A essayer :

With DEST
.Range(.Cells(1, 1), .Cells(1, UBound(var) + 1)) = var
.Range("a1").Interior.ColorIndex = 6
.Name = Range("A1").Value
End With

 

[Etn]

Re : regrouper des données de plusieurs fichiers (macros?)

Cela fonctionne...une fois de plus...c'est beau.

Merci thebenoit59 tu m'as été d'une grande aide aujourd'hui !

 

[thebenoit59]

Re : regrouper des données de plusieurs fichiers (macros?)

J'imagine la satisfaction que tu dois ressentir quand ta macro s'exécute avec succès.
Le forum me l'apporte énormément dans mes projets, ce n'est qu'une retour normal.

 

[Etn]

Re : regrouper des données de plusieurs fichiers (macros?)

Clairement ça fait plaisir !

A chaque fois je me dis que c'est terminé mais j'ai l'impression que c'est toujours améliorable.

Par exemple maintenant je souhaiterais donner une couleur aux onglets des feuilles générées. J'ai trouvé la palette sur internet, mais pas le code qui permet de l'utiliser... J'ai essayé .ColorIndex = 3 ou .Color = 3 mais ça ne fonctionne pas. (3=rouge)