Discussion :

[Vitalic]

Bonjour,

Dans un dossier, j'ai plusieurs fichiers xlsx ayant tous le même format mais pas forcément le même nom.
Je cherche à extraire certaines données (toujours les mêmes) dans la premiere feuille de chaque classeur et à les compiler dans un classeur excel que je stock dans le dossier.

Si qqn pouvait m'aider à corriger ma macro, je ne trouve pas l'erreur
(bug d'execution à cette ligne ThisWorkbook.Sheets("Feuil1").Range("A" & r) = Workbooks(fichier).Sheets("Rentabilité Projet").Range("D4").Value")

D'avance merci pour vos retours

Cdt

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Sub Compilation()
 
' Ce code doit servir à regrouper les données des feuilles de plusieurs classeurs Excel enregistrés dans le même dossier que ce classeur
 
Application.DisplayAlerts = False ' pour éviter les message demandant confirmation lors d'une fermeture (notamment le fait d'avoir des données dans le presse papier
 
chemin = ThisWorkbook.Path 'chemin du dossier qui contient les autres fichiers et où est enregistré ce fichier qui servira de compilateur
Set fso = New FileSystemObject 'l'utilisation des FSO nécessite l'activation de la référence Microsoft Scripting Runtime
Set dossier = fso.GetFolder(chemin) '
Dim r As Integer ' r sera le n° de la ligne de la feuille compilateur
r = 2
Dim nbfichiers ' nbfichier sera le nombre de fichiers traités
nbfichier = 0
Dim listedesfichierstraités As String
For Each fichier In dossier.Files ' boucle sur les fichiers
    If fso.GetExtensionName(fichier.Path) = "xlsx" And fichier.Name <> ThisWorkbook.Name Then 'sélection des fichiers à traiter : classeurs excel et pas le compilateur
    nbfichiers = nbfichiers + 1
    listedesfichierstraités = listedesfichierstraités & fichier.ShortName & Chr(10)
    Workbooks.Open fichier 'ouverture d'un fichier
 
        'For i = 1 To ActiveWorkbook.Sheets.Count ' boucle sur les feuilles de ce fichier
        Sheets("Rentabilité Projet").Select 'sélection de la feuille
 
        ThisWorkbook.Sheets("Feuil1").Range("A" & r) = Workbooks(fichier).Sheets("Rentabilité Projet").Range("D4").Value
        'ThisWorkbook.Sheets("Feuil1").Range("B" & r) = Workbooks(fichier).Sheets("Rentabilité Projet").Range("D6").Value
        'ThisWorkbook.Sheets("Feuil1").Range("C" & r) = Workbooks(fichier).Sheets("Rentabilité Projet").Range("D8").Value
        'ThisWorkbook.Sheets("Feuil1").Range("D" & r) = Workbooks(fichier).Sheets("Rentabilité Projet").Range("H8").Value
        'ThisWorkbook.Sheets("Feuil1").Range("E" & r) = Workbooks(fichier).Sheets("Rentabilité Projet").Range("C17").Value
        'ThisWorkbook.Sheets("Feuil1").Range("F" & r) = Workbooks(fichier).Sheets("Rentabilité Projet").Range("E35").Value
 
        Workbooks(fichier.Name).Activate
 
        'Next i
 
 
        r = r + 1 'on ajoute à r la dernière ligne pour toujours se placer sur la 1ère cellule vide de la colonne A
 
 
    Workbooks(fichier.Name).Close (False) 'on ferme le fichier ouvert précédemment
    End If
Next fichier
Application.DisplayAlerts = True 'on rétablie le paramétrage standard
Cells(1, 1).Select
MsgBox ("Le traitement est terminé." & Chr(10) & nbfichiers & " fichiers ont été traités, en voici la liste :" & Chr(10) & listedesfichierstraités)
 
End Sub

[varchamb]

Je suis moi même interessé par ce sujet. Si, cher Monsieur, vous avez depuis le temps trouvé une réponse à votre question, je serais heureux de pouvoir en bénéficier.

Cdlt,

[AlainTech]

Bonjour,

Une (petite) correction basée sur l'exemple donné ci-dessus:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Option Explicit
 
Sub Compilation()
  Dim chemin As String
  Dim dossier As Folder
  Dim fichier As File
  Dim fso As FileSystemObject
  Dim listedesfichierstraités As String
  Dim nbfichiers As Integer ' nbfichier sera le nombre de fichiers traités
  Dim r As Integer ' r sera le n° de la ligne de la feuille compilateur
  Dim wbkSource As Workbook
  Dim wksSource As Worksheet
 
  ' Ce code doit servir à regrouper les données des feuilles de plusieurs classeurs Excel enregistrés dans le même dossier que ce classeur
 
  Application.DisplayAlerts = False ' pour éviter les message demandant confirmation lors d'une fermeture (notamment le fait d'avoir des données dans le presse papier
  Application.EnableEvents = False ' pour éviter d'activer les macros Workbook_Open() des classeurs ouverts
 
  chemin = ThisWorkbook.Path 'chemin du dossier qui contient les autres fichiers et où est enregistré ce fichier qui servira de compilateur
  Set fso = New FileSystemObject 'l'utilisation des FSO nécessite l'activation de la référence Microsoft Scripting Runtime
  Set dossier = fso.GetFolder(chemin) '
  r = 2
  nbfichiers = 0
  For Each fichier In dossier.Files ' boucle sur les fichiers
    If fso.GetExtensionName(fichier) = "xlsx" And fichier.Name <> ThisWorkbook.Name Then 'sélection des fichiers à traiter : classeurs excel et pas le compilateur
      listedesfichierstraités = listedesfichierstraités & fichier.ShortName & Chr(10)
      Set wbkSource = Workbooks.Open(fichier.Path) 'ouverture d'un fichier
 
      Set wksSource = Nothing
      On Error Resume Next ' Ne pas traiter le fichier si la feuille cherchée n'existe pas
      Set wksSource = Sheets("Rentabilité Projet") 'sélection de la feuille
      If Not wksSource Is Nothing Then
        nbfichiers = nbfichiers + 1
        ThisWorkbook.Sheets("Feuil1").Range("A" & r) = wksSource.Range("D4").Value
        'ThisWorkbook.Sheets("Feuil1").Range("B" & r) = Workbooks(fichier).Sheets("Rentabilité Projet").Range("D6").Value
        'ThisWorkbook.Sheets("Feuil1").Range("C" & r) = Workbooks(fichier).Sheets("Rentabilité Projet").Range("D8").Value
        'ThisWorkbook.Sheets("Feuil1").Range("D" & r) = Workbooks(fichier).Sheets("Rentabilité Projet").Range("H8").Value
        'ThisWorkbook.Sheets("Feuil1").Range("E" & r) = Workbooks(fichier).Sheets("Rentabilité Projet").Range("C17").Value
        'ThisWorkbook.Sheets("Feuil1").Range("F" & r) = Workbooks(fichier).Sheets("Rentabilité Projet").Range("E35").Value
 
        r = r + 1 'on ajoute à r la dernière ligne pour toujours se placer sur la 1ère cellule vide de la colonne A
      End If
      wbkSource.Close False 'on ferme le fichier ouvert précédemment
    End If
  Next fichier
  Application.DisplayAlerts = True 'on rétablit le paramétrage standard
  Application.EnableEvents = True
  Cells(1, 1).Select
  MsgBox ("Le traitement est terminé." & Chr(10) & nbfichiers & " fichiers ont été traités, en voici la liste :" & Chr(10) & listedesfichierstraités)
 
End Sub

[berapard]

Bonsoir,

Je ne sais pas si cela est hors sujet, mais pour ma part j'utilise maintenant régulièrement la technique de consolidation de fichiers homogènes grâce par un query de type «UNION» qui peut permettre de regrouper dans une même base des données issues de plusieurs fichiers pour ensuite par exemple les synthétiser dans un TCD.

Bon courage

Philippe

[floap66]

Bonjour,

J'ai peut être trouver la solution à votre probème.

J'ai recréé votre macro et je suis venu à cette conclusion:
J'ai rajouté .Name à Workbooks(fichier.Name)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ThisWorkbook.Sheets("Feuil1").Range("A" & r) = Workbooks(fichier.Name).Sheets("Rentabilité Projet").Range("D4").Value")

Voilà. Dites moi si ça marche avec votre fichier.

Cordialement