Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL pour MAC Assembler plusieurs fichiers Excel dans un fichier / seul classeur

J

jnce84

XLDnaute Nouveau
Bonjour,

Je me permets de solliciter votre aide car je travaille sur des exportations de DATA via un site internet et pour chaque étude, j'extrais un fichier Excel. A la fin de mon étude, je me retrouve avec une vingtaine de fichiers que je dois ouvrir un par un pour pouvoir en constituer qu'un seul pour traiter ensuite mes DATA. Je perds un temps fou à ouvrir chaque fichier pour voir coller les datas dans un seul fichier / un seul classeur. Auriez-vous une solution pour par exemple sélectionner tous les fichiers dans mon dossier et faire un click droit "assembler" (oui je rêve mais ça serait tellement idéal )

Voici un exemple de 3 fichiers que je voudrais assembler en un seul (Fichier Assemblage)

Merci pour votre aide, ça me ferait gagner un temps fou pour chaque export.

Fichier assemblé
Source1
Source2
Source3
 
Trier par date Trier par votes
J

jnce84

XLDnaute Nouveau
oui tout est bien là et correspond bien à ta ligne "liste = Array("Source1.xlsx", "Source2.xlsx", "Source3.xlsx") 'liste des fichiers, à adapter"
 

Pièces jointes

  • Capture d’écran 2021-01-24 à 19.45.02.jpg
    16.3 KB · Affichages: 32
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
C'est pas possible ça, MAC c'est une vraie catastrophe, alors testez ce fichier (3 bis) avec :
VB: 
Sub Assembler()
Dim chemin$, liste, feuille$, ncol%, lig&, n%, 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 n = 0 To UBound(liste)
        form = "'" & chemin & "[" & liste(n) & "]" & 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
 

Pièces jointes

  • Assemblage(3 bis).xlsm
    19.9 KB · Affichages: 2
Vote positif 0 Vote négatif
J

jnce84

XLDnaute Nouveau
Pour info,
voici une solution proposée qui a fonctionné

Sub Assembler()

rep = thisworkbook.path & application.pathseparator 'pour Ergotamine

fichier = dir(rep)
while fichier <> ""
if fichier like "*.xlsx" and fichier <> thisworkbook.name 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
 
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
D'après ce que je vois sur MAC Dir n'accepte pas le caractère générique *.

Alors testez ce fichier (4) avec :
VB: 
Sub Assembler()
Dim chemin$, fichier$, feuille$, ncol%, lig&, form$, h&
chemin = ThisWorkbook.Path & Application.PathSeparator 'dossier à adapter
fichier = Dir(chemin) '1er fichier du dossier
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
    While fichier <> ""
        If fichier Like "*.xlsx" Then
            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
        End If
        fichier = Dir 'fichier suivant
    Wend
    With .UsedRange: End With 'actualise les barres de défilement
End With
End Sub
Nota : la colonne A des fichiers sources doit contenir des textes.
 

Pièces jointes

  • Assemblage(4).xlsm
    18.3 KB · Affichages: 3
  • Source1.xlsx
    7.2 KB · Affichages: 3
  • Source2.xlsx
    7.4 KB · Affichages: 3
  • Source3.xlsx
    11.4 KB · Affichages: 3
Vote positif 0 Vote négatif
J

jnce84

XLDnaute Nouveau

Effectivement les fichiers sources ne s'ouvrent pas ! c'est bien plus optimal.

@job75 Aussi dans mes fichiers sources, j'ai des lignes sans DATA en colonne B C D E... est-ce qu'on peut faire en sorte d'exclure ces DATA en colonne A ne soit pas copier dans mon fichier d'assemblage ? En gros vide en colonne B alors on ne copie pas le mot dans le fichier d'assemblage.

Voici le code qu'on m'avait donner pour faire cela mais si tu peux adapter ton code ça serait encore mieux vu qu'on ouvre pas les sources

Et tant que j'y suis... est-ce que tu penses qu'il serait possible de supprimer en même temps tous les doublons en colonne A lors de l'assemblage ?

Code: 
Sub Assembler()

rep = thisworkbook.path & application.pathseparator 'pour Ergotamine :)

fichier = dir(rep)
while fichier <> ""
    if fichier like "*.xlsx" and fichier <> thisworkbook.name 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
 
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
Bonjour jnce84,

Testez ce fichier(5) et la macro :
VB: 
Sub Assembler()
Dim chemin$, fichier$, feuille$, ncol%, lig&, form$, h&
chemin = ThisWorkbook.Path & Application.PathSeparator 'dossier à adapter
fichier = Dir(chemin) '1er fichier du dossier
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
    While fichier <> ""
        If fichier Like "*.xlsx" Then
            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
                End With
                lig = lig + h - 1
            End If
        End If
        fichier = Dir 'fichier suivant
    Wend
    With .UsedRange
        .Replace 0, "", xlWhole 'supprime les zéros
        .RemoveDuplicates 1, Header:=xlYes 'supprime les doublons en colonne A
    End With
    With .UsedRange
        .Columns(ncol + 1) = "=1/SIGN(COUNTA(RC2:RC[-1]))" 'NBVAL
        .Columns(ncol + 1) = .Columns(ncol + 1).Value 'supprime les formules
        .EntireRow.Sort .Columns(ncol + 1), xlAscending, Header:=xlYes 'tri pour regrouper et accélérer
        On Error Resume Next 'si aucune SpecialCell
        .Columns(ncol + 1).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete 'supprime les lignes
        .Columns(ncol + 1) = ""
    End With
    With .UsedRange: End With 'actualise les barres de défilement
End With
End Sub
A+
 

Pièces jointes

  • Assemblage(5).xlsm
    19.7 KB · Affichages: 4
Vote positif 0 Vote négatif
J

jnce84

XLDnaute Nouveau

Tout semble OK avec ton fichier (5) ! Merci ENORMEMENT !
 
Vote positif 0 Vote négatif
J

jnce84

XLDnaute Nouveau
Bonsoir job75,
Je voudrais créer un nouveau fichier d'assemblage pour ces 3 sources ? Est-ce que tu pourrais adapter ton code ? ça m'avancerait énormément dans mon travail ! même principe à savoir assemblage et suppression des doublons lors de la génération

Merci d'avance !
Jonathan
 

Pièces jointes

  • Archive.zip
    54.5 KB · Affichages: 2
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Question
Power Query [Resolu] Importer plusieurs fichiers excel provenant de dossiers différents sur sharepoint
Réponses
6
Affichages
1 K
Staple1600
F
  • Résolu(e)
Autres Mapper fichier XML dans Excel avec TLE
2
Réponses
21
Affichages
457
FS69
F
C
  • Question
XL 2021 Dupliquer un fichier selon une liste déroulante
Réponses
2
Affichages
208
catdog
C
V
  • Question
Microsoft 365 Resume de plusieurs fichier
Réponses
2
Affichages
316
Cousinhub
I
  • Résolu(e)
Microsoft 365 Ouvrir un fichier Excel rapidement en VBA
3 4 5
Réponses
61
Affichages
3 K
iliess
I
F
  • Question
Microsoft 365 comment ouvrir en lecture/écriture un fichier EXCEL placé sous sharepoint
Réponses
2
Affichages
889
fibled
F
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
404
Chaton77
L
  • Résolu(e)
XL 2016 Récupérer données de différents fichiers Excel et rappatrier dans 1 seul fichier
Réponses
5
Affichages
694
LAPIN-53
L
Z
  • Question
XL 2016 Macro pour copier plusieurs cellules vers un fichier :(
Réponses
3
Affichages
303
zendb
Z
T
  • Question
XL 2019 Ouvrir et modifier un fichier Excel dans un autre
Réponses
4
Affichages
378
Theca
T
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…