Consolidation

Bonjour à tous,

Mon sujet est un peu similaire de certains sujet mais en regardant de plus prêt il en reste pas moins différent, je viens vers vous pour avoir de l'aide j'ai plusieurs classeurs (4 en tout) nommé Base_ECO......xlsm

J'aimerais récupérer toutes les infos de ces classeurs dans la feuille "BASE" à partir de la ligne A2 et les copier vers le Classeur1 dans la feuil1 en ligne A2.

Sachant que tous ces classeurs ont la même structure, j'avais commencer un code mais au final il ne récupérer pas toutes les informations de tous les fichiers.

Merci beaucoup pour votre aide.

Bonjour,

Il serait utile de produire quelques fichiers source type ...

Bonjour,

Je vous transféré un des fichier type comme exemple j'ai essayer mais j'ai un bug à un endroit malgres avoir fait les modif.

Il s'agit d'un fichier exemple (les 4 fichiers sont au formats .xlsm et contiennent plusieurs onglets et je nesouhaite que l'onglet base qui possède la même structure que celui donné en exemple.) j'aimerais tous les consolider dans un fichier vierge normé recap.

J'avais effectuer un début de macro mais je bloqué sur la sélection de l'onglet base. Je vous la transfère ici:

Sub Compilation()
Dim Temp As String
Dim Ligne As Long
Temp = Dir(ActiveWorkbook.Path & "\*.xls")
Application.DisplayAlerts = False
Do While Temp <> ""
If Temp <> "Recap.xls" Then
Workbooks.Open ActiveWorkbook.Path & "\" & Temp
Workbooks(Temp).Sheets(1).Range("A1").CurrentRegion.Copy
Workbooks("Recap.xls").Sheets(1).Activate
Ligne = Sheets(1).Range("A65536").End(xlUp).Row + 1
Range("A" & CStr(Ligne)).Select
ActiveSheet.Paste
Workbooks(Temp).Close
End If
Temp = Dir
Loop
Range("A1").Select
Application.DisplayAlerts = True
End Sub

Merci beaucoup pour votre aide.

Bonjour Momo

Le sujet me paraissait clair et donc je n'ai pas insisté pour avoir un exemple de fichier. J'aurais dû !!

Momo_92500ouz a écrit :

...nommé Base_ECO......xlsm

...feuille "BASE" à partir de la ligne A2 et les copier vers le Classeur1 dans la feuil1 en ligne A2.

Tes classeurs sont en xlsx et non xlsm, et aucun ne possède de feuille nommée BASE

Ton code n'est pas indenté, on n'y voit pas clair.

Maintenant je veux bien corriger le code, mais j'aimerais que tu me confirmes quand même que ton fichier de base ne comporte qu'une seule feuille.

Réponse effacée, le problème a quelque peu évolué.

Bonjour,

Non mes classeurs de base comprennent 5 feuilles mais je souhaites retirer que les informations de la feuille nommés bases sur les 4 classeurs et les compilé dans un seul classeur. j'ai juste envoyé a quoi ressemble la partie que je souhaite extraire.

Voici un fichier un peu plus explicite avec 2 feuilles. Désolé pour ce désagrément. Je sais qu'il est en xlsx mais le fichier de base est en xlsm.

Merci pour votre aide.

Essaie ceci ... (en espérant qu'il n'y ait pas d'autres écarts avec la réalité)

Option Explicit

    Dim wbk1 As Workbook, wbk2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rng1 As Range, rng2 As Range

    Dim chemin$, monFichier$, onglet$

Sub collecter()

    ' à modifier ...
    chemin = ThisWorkbook.Path & "\test\"

    Set wbk1 = ThisWorkbook
    Set ws1 = ActiveSheet
    ws1.Cells(1).CurrentRegion.Offset(1, 0).ClearContents
    monFichier = Dir(chemin & "*.xlsm")

    Do While monFichier <> ""
            Set wbk2 = Workbooks.Open(chemin & monFichier)
            Set ws2 = wbk2.sheets("BASE")
            Set rng2 = ws2.Cells(1).CurrentRegion
            rng2.Offset(1).Resize(rng2.Rows.Count - 1, rng2.Columns.Count).Copy
            Set rng1 = ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            rng1.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False
            wbk2.Close False
            monFichier = Dir
    Loop

    ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select

End Sub

Merci beaucoup.

Le seul probleme que je rencontre la c un bug sur la ligne en gras :

Option Explicit

    Dim wbk1 As Workbook, wbk2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rng1 As Range, rng2 As Range

    Dim chemin$, monFichier$, onglet$

Sub collecter()

    ' à modifier ...
    chemin = ThisWorkbook.Path & "S:\00.Groupe \Direction \Fichiers Partagés\ REPORTING"

    Set wbk1 = ThisWorkbook
    Set ws1 = ActiveSheet
    ws1.Cells(1).CurrentRegion.Offset(1, 0).ClearContents
    [b]monFichier = Dir(chemin & "BASE*.xlsm")[/b]

    Do While monFichier <> ""
            Set wbk2 = Workbooks.Open(chemin & monFichier)
            Set ws2 = wbk2.Sheets("BASE")
            Set rng2 = ws2.Cells(1).CurrentRegion
            rng2.Offset(1).Resize(rng2.Rows.Count - 1, rng2.Columns.Count).Copy
            Set rng1 = ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            rng1.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False
            wbk2.Close False
            monFichier = Dir
    Loop

    ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select

End Sub)

je ne vois pas pk ca bug alors que j'ai rentré le chemin et que j'ai positionné le fichier compilation ou ce situe les autres classeurs.

Merci pour votre temps.

Désolé ca ne l'a pas afficher en gras dans le code c'est la ligne monFichier = Dir(chemin & "BASE*.xlsm").

merci

Tu es sûr de ton chemin, y compris avec des espaces ?

Oui c'est exactement ce chemin écrit de la même manière je viens de revérifier.

Ça m'affiche "Nom ou numéro de fichier incorrect". Je ne vois pas en quoi franchement.

Merci

Oui c'est exactement ce chemin écrit de la même manière je viens de revérifier.

Ça m'affiche "Nom ou numéro de fichier incorrect". Je ne vois pas en quoi franchement.

Merci bcp

Remplace

chemin = ThisWorkbook.Path & "S:\00.Groupe \Direction \Fichiers Partagés\ REPORTING"

par

chemin = "S:\00.Groupe \Direction \Fichiers Partagés\ REPORTING"

Bonsoir,

Cette fois zéro bug mais un soucis c'est que rien ne se passe. Les fichiers sont protégés et je me demande si ça à un impact ? Peut-être que c'est pour cette raison que rien ne s'affiche. Au passage mes fichiers sont juste protégés pour pas qu'il n'y ai de modif.

Merci beaucoup en tout cas aucun bug ne se déclare et je pense que la macro est correct.

Donc les fichiers n'étaient toujours pas représentatifs.

As-tu essayé avec le fichier que tu m'avais donné, quitte à le recopier plusieurs fois dans un dossier ?

Bonjour,

J'ai essayé sur le fichier classique partagé et toujours le même bug sur la ligne : monfichier =...

Dommage, car ceci fonctionne bien https://forum.excel-pratique.com/viewtopic.php?p=805424#p805424

Donc les fichiers postés ne sont pas représentatifs, ou bien ton nom de dossier est erroné, ou bien il fat remplacer les espaces par %20.

Essaie déjà en rapatriant un fichier sur TON ordinateur.