Assembler plusieurs fichiers Excel dans un fichier / seul classeur

Bonjour,

En executant pas à pas comme conseillé par 3GB, les fichiers du répertoire s'ouvrent-ils à la ligne "Set wb = Workbooks.Open(rep & fichier)" ?

Comment est construite ton arborescence de fichier ?

Bonne soirée !

Quand je clique sur pas à pas, ça s'arrête ici. Est-ce que je dois appuyer pour continuer la manip?

Aussi un autre personne m'a proposé ce code avec lequel j'ai un appel des DATA mais uniquement du fichier Source1. Peut-être que cela pourra nous aider :)

Sub Assembler()
Dim chemin$, liste, feuille$, ncol%, lig&, fichier, form$, h&
chemin = ThisWorkbook.Path & Application.PathSeparator 'dossier à adapter
liste = Array("Source1.xlsx", "Source2.xlsx", "Source3.xlsx") 'liste des fichiers, à adapter
feuille = "Keywords" 'nom des feuilles à copier, à adapter
ncol = 15 'nombre de colonnes, à adapter
lig = 2 '1ère ligne de restitution, à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Feuil1 'CodeName à adapter
    .UsedRange.EntireRow.Offset(1).Delete 'RAZ
    For Each fichier In liste
        form = "'" & chemin & "[" & fichier & "]" & feuille & "'!"
        h = 0
        On Error Resume Next
        h = ExecuteExcel4Macro("MATCH(""zzz""," & form & "C1)") 'calcul sur colonne 1
        On Error GoTo 0
        If h > 1 Then
            With .Cells(lig, 1).Resize(h - 1, ncol)
                .FormulaArray = "=" & form & "R2C1:R" & h & "C" & ncol 'formule de liaison matricielle
                .Value = .Value 'supprime la formule
                .Replace 0, "", xlWhole 'supprime les zéros
            End With
            lig = lig + h - 1
        End If
    Next
    With .UsedRange: End With 'actualise les barres de défilement
End With
End Sub

Bonjour,

Il faut que tu appuies plusieurs fois sur F8, chaque action exécute la ligne suivante.

Quand la ligne en dessous de Set wb est surlignée, indique nous si un fichier source est ouvert.

j'ai trouvé que sur MAC le F8 est Shift-CMD-i Alors la ligne jaune passe While fichier <> "" directement sur ThisWorkbook.Save

alors pour le coup, le code que j'ai mis de l'autre personne ouvre bien une fenêtre d'explorateur

Excellente initiative et avancée !

Si dans les codes que mes 2 camarades t'ont proposé tu remplaces

"ThisWorkbook.Path & "\exempleforum\"

par

 "ThisWorkbook.Path & Application.PathSeparator"

et que tu fais la même manipulation, qu'obtient-tu ?

ça m'ouvre bien une fenêtre d'explorer mais ne retourne pas de résultat. Le code était prévu pour ne pas être mis dans le même répertoire que mes fichiers, peut être ça ?

@mdo100 avec le debug pas de fenêtre d'explorateur ne s'affiche (je deviens un pro du debug :p) mais par contre "ChDir ActiveWorkbook.Path" retourne bien le chemin.

Re,

Je viens de faire une recherche et c'est apparemment dû au fait que sur MAC, la fonction Dir traite les métacaractères "*" et "?" comme des caractères normaux, rendant la recherche vaine.

Essaie en modifiant le premier Dir, l'appel, ainsi :

fichier = dir(rep, macid("XLS5"))

Et désolé d'avoir douté de toi et de ton investissement (mais si tu savais le nombre de fois où j'ai rencontré la même situation...)

Cdlt,

Merci je teste ça dans 5min (je dois sortir le chien ahah)

juste pour info sur le code que j'avais copié, j'ai tenté de modifier l'ordre des fichiers et... ça a fonctionné ! trop bizarre non ? bon par contre il faut que je liste tous les fichiers et c'est pas le but si j'ai 100 fichier :d mais je colle ça juste au cas où :

Option Explicit

Sub Assembler()
Dim chemin$, liste, feuille$, ncol%, lig&, fichier, form$, h&
chemin = ThisWorkbook.Path & Application.PathSeparator 'dossier à adapter
liste = Array("Source3.xlsx", "Source1.xlsx", "Source2.xlsx")
feuille = "Keywords" 'nom des feuilles à copier, à adapter
ncol = 15 'nombre de colonnes, à adapter
lig = 2 '1ère ligne de restitution, à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Feuil1 'CodeName à adapter
    .UsedRange.EntireRow.Offset(1).Delete 'RAZ
    For Each fichier In liste
        form = "'" & chemin & "[" & fichier & "]" & feuille & "'!"
        h = 0
        On Error Resume Next
        h = ExecuteExcel4Macro("MATCH(""zzz""," & form & "C1)") 'calcul sur colonne 1
        On Error GoTo 0
        If h > 1 Then
            With .Cells(lig, 1).Resize(h - 1, ncol)
                .FormulaArray = "=" & form & "R2C1:R" & h & "C" & ncol 'formule de liaison matricielle
                .Value = .Value 'supprime la formule
                .Replace 0, "", xlWhole 'supprime les zéros
            End With
            lig = lig + h - 1
        End If
    Next
    With .UsedRange: End With 'actualise les barres de défilement
End With
End Sub

Aucun problème 3GB ! Je n'ai pas envie d'avoir la réponse sans comprendre, j'ai fait des études de développement web donc les codes me parlent et ça m'intéresse

Alors j'ai fait ce que tu m'as demandé et :

et pour info on part bien sur des / et non \ à en juger les Path ?

En pas à pas détaillé, ça plante à quelle ligne ?

Ca me semble bizarre d'avoir ça

fichier = dir(rep, macid("XLS5"))

Sans spécifier de nom de fichier ou via un équivalent du caractère générique * ..

sur fichier = Dir(rep, MacID("XLS5"))

Et en essayant avec fichier = Dir(rep, MacID("XLSX")).

Je n'ai vu que ça comme pistes sur Internet, j'espère que ça va marcher...

Edit : @Ergotamine, oui mais sur Mac, c'est pas pareil. Tout est mieux sauf Excel ! Et la fonction Dir est un des inconvénients.

toujours pas :( je pense qu'on est pas très loin je regarde des anciens messages sur Dir avec Mac et on va finir par trouver :D

J'espère !

Au cas où quand même, il y a une alternative ici : https://forum.excel-pratique.com/excel/utiliser-la-fonction-dir-pour-la-version-mac-d-excel-t77583.h...

Mais sur ce lien : https://support.microsoft.com/fr-fr/office/macid-fonction-b2579836-947b-42bd-b800-fafcb798869a Il est question de "XLS5". Après, est-ce que c'est propre à Access, j'en doute.

Ton problème n'était pas dû aux séparateurs, qui étaient inversés ? Ce serait bête d'être passé à côté.

Je continue de chercher quand même.

Je voulais aussi vous copier le lien mais je suis trop nouveau donc pas possible :p je creuse aussi merci !

Pour le séparateur j'ai tenté les 2 mais rien

rep = ThisWorkbookPath & Application.PathSeparator & "exempleforum" & Application.PathSeparator

Une idée tardive, peut être que mes neurones vont se toucher !

Mais en fait, je suis un peu demeuré... Parce que dans ton cas, il n'est pas strictement nécessaire de filtrer l'extension ?

Peux-tu essayer ainsi :

Sub Assembler()

rep = thisworkbook.path & "/exempleforum/"

fichier = dir(rep)
while fichier <> ""
    if fichier like "*.xlsx" then 'on le fait quand même mais après
        set wb = workbooks.open(rep & fichier)
        with wb.sheets(1).usedrange
            t = .offset(1,0).resize(.rows.count - 1, .columns.count)
        end with
        with thisworkbook.sheets(1)
            if .cells(1,1) = "" then .rows(1).value = wb.sheets(1).rows(1).value
            nvl = .cells(.rows.count, 1).end(xlup).row + 1
            .cells(nvl, 1).resize(ubound(t), ubound(t,2)) = t
        end with
        wb.close true
    end if
    fichier = dir
wend

thisworkbook.save

end sub

@Ergotamine : Non, c'est pas un problème de séparateur, c'est vraiment la fonction Dir qui n'agit pas de la même façon sur Mac !

Le problème, c'est qu'on est mal parti et qu'on a cherché à solutionner un problème qui, dans le cas présent, aurait dû être contourné.

Je croise les doigts

ça marchhhhhhhhhhhhhhhhe ! trop bien merci beaucoup

Est-ce que vous pensez qu'on peut "améliorer" le code sans à devoir à remplir le "/exempleforum/" ? Idéalement j'aimerai mettre le fichier assembler.xlsm dans le répertoire avec tous mes fichiers et juste à exécuter la macro et op