Consolidation des classeurs

SVP je souhaite consolider les données de plusieurs fichiers excels dans un seul global !

J'ai utilisé pour essayé ce code mais toujours des erreurs ,et il n'y a pas de tutos en Français sur le net :

SVP aidez moi via un code VBA ?

j'ai essayé ce code pour tester, mais j'ai eu une erreure:

Sub ConsolidateData()
Range("A1").Select
ActiveCell.Value = "Item"
Range("B1").Select
ActiveCell.Value = "Qty"
Range("A2").Select
ActiveCell.Value = "a"
Range("A3").Select
ActiveCell.Value = "b"
Range("A4").Select
ActiveCell.Value = "c"
Range("B2").Select
Workbooks.Open Filename:="C:\Stock-Sales\a.xlsx"
Workbooks.Open Filename:="C:\Stock-Sales\b.xlsx"
Workbooks.Open Filename:="C:\Stock-Sales\c.xlsx"
Windows("consolidate").Activate
Selection.Consolidate Sources:=Array( _
"'C:\Stock-Sales\[a.xlsx]Sheet1' !R2C2:R4C2", _
"'C:\Stock-Sales\[b.xlsx]Sheet1' !R2C2:R4C2", _
"'C:\Stock-Sales\[c.xlsx]Sheet1' !R2C2:R4C2"), Function:=xlSum
Windows("a.xlsx").Activate
ActiveWorkbook.Close
Windows("b.xlsx").Activate
ActiveWorkbook.Close
Windows("c.xlsx").Activate
ActiveWorkbook.Close
End Sub

//////////////sachant qu'ils sont tous dans le méme dossier !

L'erreur est :Référence de consolidation non valide , pourtant le macro "consolidate" est dans le méme dossier avec les autres

Aidez moi svp je veux consolider automatiquement les données de plusieurs classeurs dans un seul!

Cordialement,

Lynda

bonjour,

une proposition de correction

Sub ConsolidateData()
Range("A1").Select
ActiveCell.Value = "Item"
Range("B1").Select
ActiveCell.Value = "Qty"
Range("A2").Select
ActiveCell.Value = "a"
Range("A3").Select
ActiveCell.Value = "b"
Range("A4").Select
ActiveCell.Value = "c"
Range("B2").Select
Workbooks.Open Filename:="C:\Stock-Sales\a.xlsx"
Workbooks.Open Filename:="C:\Stock-Sales\b.xlsx"
Workbooks.Open Filename:="C:\Stock-Sales\c.xlsx"
Windows("consolidate.xlsm").Activate ' ajouter l'extension du fichier xlsm ou xlsx suivant le cas
Selection.Consolidate Sources:=Array( _
"'C:\Stock-Sales\[a.xlsx]Sheet1'!R2C2:R4C2", _
"'C:\Stock-Sales\[b.xlsx]Sheet1'!R2C2:R4C2", _
"'C:\Stock-Sales\[c.xlsx]Sheet1'!R2C2:R4C2"), Function:=xlSum
Windows("a.xlsx").Activate
ActiveWorkbook.Close
Windows("b.xlsx").Activate
ActiveWorkbook.Close
Windows("c.xlsx").Activate
ActiveWorkbook.Close
End Sub

Je vous remercie pour votre aide, mais toujours pas ,ils me disent "erreur de syntaxe "

Selection.Consolidate Sources:=Array( _ ' supprimer l'espace avant le !
"'C:\Stock-Sales\[a.xlsx]Sheet1'!R2C2:R4C2", _
"'C:\Stock-Sales\[b.xlsx]Sheet1'!R2C2:R4C2", _
"'C:\Stock-Sales\[c.xlsx]Sheet1'!R2C2:R4C2"), Function:=xlSum

Il y'a une erreur ici quelque part

Bonsoir,

code corrigé dans mon message précédent

Je l'ai testé, au début les numéros sont apparus vite fait dans le fichier consolidate (2 secondes comme un flash lol), après les cases sont devenues vides et j'ai eu une erreur: (impossible d'ouvrir le fichier source de la consolidation '[a.xlsx]Sheet1' ) , (impossible d'ouvrir le fichier source de la consolidation '[b.xlsx]Sheet1' ), (impossible d'ouvrir le fichier source de la consolidation '[c.xlsx]Sheet1' )

bonjour,

vérifie le nom des fichiers (y compris l'extension .xlsx) et le nom du répertoire

vérifie que tu as bien un onglet sheet1 dans chacun de ces fichiers.

Dans les ongles j'ai :Feuil1, Feuil2, Feuil3 et non pas Sheet1, Sheet2, Sheet3 et j'ai Classeur qui est renommé par "consolidate" et non pas Workbooks !

Le problème est résolu ,merci

C'était un problème de langue lol (au lieu de Sheet1 c Feuil1 ^^) c tous

Merci beaucoup de m'avoir aider c gentil

J'ai un autre problème lol

Enfaite j'ai un fichier macro qui s'appelle "zmaster" et trois fichier excel dans le méme dossier (supplier-a , supplier-b, supplier-c)

Quand j'execute la macro, voici l'erreur que je trouve : Erreur d'execution '1004'; 'supplier-a.xlsx' introuvable, vérifiez l'orthographe du nom du classeur et la validité d'emplacement.

Si vous essayez d'ouvrir le fichier à partir de la liste des fichiers les plus récents, assurez vous que le fichier n'a pas été renommé, déplacé ou supprimer ,voici le code:

Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
MyFile = Dir("C:\suppliers-master\")
Do While Len(MyFile) > 0
If MyFile = "zmaster.xlsm" Then
Exit Sub
End If
Workbooks.Open (MyFile)
Range("A2:D2").Copy
Active.Workbook.Close
erow = Feuil1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Feuil1").Range(Cells(erow, 1), Cells(erow, 4))
MyFile = Dir
Loop
End Sub

Bonjour,

à tester

Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
monchemin="C:\suppliers-master\"
MyFile = Dir(monchemin & "supplier*.xls*")
Do While Len(MyFile) > 0
Workbooks.Open (monchemin & MyFile)
Range("A2:D2").Copy
ActiveWorkbook.Close
erow = worksheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Feuil1").Range(Cells(erow, 1), Cells(erow, 4))
MyFile = Dir
Loop
End Sub

Toujours pas, les cases du macro ne se remplissent pas ,mais y'a le fichier a-supplier.xlsx qui apparait et sa case se sélectionne !

Voici l'erreur:" Erreur d'execution 424 object acquis"

Bonjour,

j'ai corrigé une erreur dans mon message précédent.

Tu avais écrit

active.workbook.close

il faut écrire

activeworkbook.close

Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
monchemin = "C:\suppliers-master\"
MyFile = Dir(monchemin & "supplier.xls")
Do While Len(MyFile) > 0
Workbooks.Open (monchemin & MyFile)
Range("A2:D2").Copy
Active.Workbook.Close
erow = Worksheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Feuil1").Range(Cells(erow, 1), Cells(erow, 4))
MyFile = Dir
Loop
End Sub

J'ai eu aucune erreure mais les cases ne sont aps remplies

rebonjour,

une nouvelle correction sur base de ce que j'ai compris de l'erreur que tu reçois et des noms de fichiers que tu cherches à traiter

Sub LoopThroughDirectory()
    Dim MyFile As String
    Dim erow
    Set twb = ThisWorkbook
    monchemin = "C:\suppliers-master\"
    MyFile = Dir(monchemin & "*supplier*.xls*")
    Do While Len(MyFile) > 0
        Set swb = Workbooks.Open(monchemin & MyFile)
        erow = twb.Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        swb.Sheets("feuil1").Range("A2:D2").Copy twb.Range("A" & erow)
        MyFile = Dir
    Loop
End Sub

Toujours pas ,ils me disent "erreur d'exécution 438", Propriété ou méthodes no générée par cet objet

bonjour

Sub LoopThroughDirectory()
    Dim MyFile As String
    Dim erow
    Set twb = ThisWorkbook
    monchemin = "C:\suppliers-master\"
    MyFile = Dir(monchemin & "*supplier.xls*")
    Do While Len(MyFile) > 0
        Set swb = Workbooks.Open(monchemin & MyFile)
        erow = twb.Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        swb.Sheets("feuil1").Range("A2:D2").Copy twb.Sheets("Feuil1").Range("A" & erow)
        MyFile = Dir
    Loop
End Sub