Grouper la data de plusieurs fichiers dans un seul fichier global

Bonjour tout le monde !

Je suis tout à fait novice dans le fabuleux univers du VBA, et on m'a confié une tâche pour laquelle je manque cruellement d'expérience.

Je possède des fichiers de données collectées par sondages. Ces fichiers sont construits de la même façon. Je dois regrouper les informations qu'ils contiennent dans un fichier global. Ce qui m'intéresse c'est seulement de récupérer le contenu des différentes lignes, sans s'occuper des formules, j'ai juste besoin du texte.

Les fichiers seront nommés différemment à chaque fois, mais seront placés dans le même dossier.

Le nombre de ces fichiers peut être amené à évoluer (nouveaux sondages).

Le macro doit être capable d'aller chercher tout fichier excel présent dans un dossier donné, récupérer toutes les lignes, ajouter ces lignes dans mon fichier de synthèse.

Ma demande est-elle claire ?

Merci d'avance pour vos réponse !

Bonjour,

Voici un essai avec le fichier exécutant au sein du dossier contenant les fichiers à sonder. Tous ces fichiers (excepté l'exécutant) doivent être fermés au lancement de la macro.

On récupère à chaque fois le contenu de la feuille 1 et on restitue le tout sur la feuille 1 du classeur exécutant.

Les fichiers sont construits de la même façon et sont donc supposés contenir le même nombre de colonnes :

sub test()
dim t()
with thisworkbook
    sfilename = dir(.path & "\*.xls*")
    do while sfilename <> ""
        if sfilename <> .name then
            n = n + 1: redim preserve t(1 to n)
            with workbooks.open(.path & "\" & sfilename) 
                t(n) = .sheets(1).usedrange.value
                .close true
            end with
        end if
        sfilename = dir
    loop
    tbl = Convert3Dto2D(t)
    with .sheets(1)
        nvl = .cells(.rows.count, 1).end(xlup).row + 1
        .cells(nvl, 1).resize(ubound(tbl), ubound(tbl, 2)).value = tbl
    end with
end with
end sub

function Convert3Dto2D(ArrSrc)
dim temp()
for i = lbound(ArrSrc) to ubound(ArrSrc)
    for j = lbound(ArrSrc(i)) to ubound(ArrSrc(i))
        n = n + 1: redim preserve temp(1 to ubound(ArrSrc(i), 2), 1 to n)
        for k = lbound(ArrSrc(i), 2) to ubound(ArrSrc(i), 2)
            temp(k, n) = ArrSrc(i)(j, k)
        next k
    next j
next i
Convert3Dto2D = application.transpose(temp)
end function

Cdlt,

Bonjour,

Je vous remercie grandement pour l'aide que vous m'avez apporté. Donc pour des fichiers aux colones identiques ça marche très bien, en réalité la longueur des sondages peut varier et j'aimerais savoir s'il était possible:

- de sélectionner uniquement les colonnes J à L (donc de la 10 à la 12)

- de ne pas sélectionner/récupérer les 2 premières lignes des fichiers

Je vous remercie encore

Cordialement

Axel

Bonjour à tous

Cela est généralement faisable sans VBA, de façon assez simple avec PowerQuery, totalement intégré à Excel à partir la version 2016, en add on dur 2010 et 2013

Joins un ou deux exemples représentatifs

Merci aussi de compléter ton profil en indiquant ta version Excel

Bonjour chris,

Vous voulez que je vous joigne 2 exemples de fichiers c'est ça?

En fait les fichiers dans le répertoire de travail vont être amenés à être écraser pour avoir de nouvelles données plus récentes et mon responsable voudrait que le fichier se mette à jour quasiment automatiquement juste en appuyant sur un bouton pour ne pas avoir à s'embêter et à perdre du temps à récolter toutes les infos chaque semaine.

Pensez vous que cela serait possible avec PowerQuery?

PS: je viens de mettre à jour mon profil

Cdt

Oui

RE

Resterait dans la requête à renommer les 3 colonnes et éventuellement supprimer la colonne indiquant le fichier source

Modifie le dossier dans la cellule jaune puis Données, Actualiser tout

Chaque fois qu'on actualise cela lit ce qui est présent dans le dossier à ce moment

RE

Super ça marche nickel, merci beaucoup pour ton aide.

Bonne journée à vous

Cdt

Axel

Bonjour à tous,

Voici un essai avec la macro test modifiée :

sub test()
dim t()
with thisworkbook
    sfilename = dir(.path & "\*.xls*")
    do while sfilename <> ""
        if sfilename <> .name then
            n = n + 1: redim preserve t(1 to n)
            with workbooks.open(.path & "\" & sfilename) 
                with .sheets(1).usedrange
                    t(n) = .offset(2, 9).resize(.rows.count - 2, 3).value
                end with
                .close true
            end with
        end if
        sfilename = dir
    loop
    tbl = Convert3Dto2D(t)
    with .sheets(1)
        nvl = .cells(.rows.count, 1).end(xlup).row + 1
        .cells(nvl, 1).resize(ubound(tbl), ubound(tbl, 2)).value = tbl
    end with
end with
end sub

Cdlt,

Super,

La macro marche aussi parfaitement, je te remercie pour ton aide

Cdt

AxeletBiome