XL 2019 Ouverture fichiers excel et copier des lignes

A

AKOLIAI

XLDnaute Nouveau
Bonjour à tous,
Je ne suis pas très a l'aise avec VBA
mon besoin est le suivant :
j'ai un dossier qui contient des fichiers nommés (1, 2, 3, 4,...N)
Dans un fichier Excel deja ouvert je souhaite faire une macro qui fait l'action suivante :
Ouvrir les fichiers de 1 à N (un par un) et de copier la ligne 1 de l'onglet 1 du fichier 1 dans la fichier excel deja ouvert
et refaire la meme chose mais le soucis c'est que ça ne doit pas écraser la ligne qui a été copiée

Merci, je reste dispo pour clarifier si besoin

Merci par avance de votre précieuse aide :)

Bn courage à vous
 
Trier par date Trier par votes
Hasco

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Vous avez excel 2019, faites le à partir de PowerQuery, inclus dans votre version.

Importer des données à partir d’un dossier contenant plusieurs fichiers (Power Query) - Support Microsoft

Utilisez l’expérience Get & Transform (Power Query) d’Excel pour combiner plusieurs fichiers, qui ont le même schéma, à partir d’un dossier unique dans une table unique.
support.microsoft.com support.microsoft.com
Cliquez pour agrandir...

Vous pourrez ne conserver que les premières lignes si vous voulez.
Commencez puis revenez avec vos difficultés et deux ou trois fichiers exemple anonymisés à importer.

cordialement
 
Vote positif 0 Vote négatif
P

psgfun

XLDnaute Nouveau
AKOLIAI à dit:
Bonjour à tous,
Je ne suis pas très a l'aise avec VBA
mon besoin est le suivant :
j'ai un dossier qui contient des fichiers nommés (1, 2, 3, 4,...N)
Dans un fichier Excel deja ouvert je souhaite faire une macro qui fait l'action suivante :
Ouvrir les fichiers de 1 à N (un par un) et de copier la ligne 1 de l'onglet 1 du fichier 1 dans la fichier excel deja ouvert
et refaire la meme chose mais le soucis c'est que ça ne doit pas écraser la ligne qui a été copiée

Merci, je reste dispo pour clarifier si besoin

Merci par avance de votre précieuse aide :)

Bn courage à vous
Cliquez pour agrandir...
Bonsoir.
Ci-joint 4 fichiers test (1-2-3-Z)
Les trois premiers sont source.
Le dernier est destination.
N'hésite pas à ouvrir la macro (macro1) en mode pas à pas pour voir son fonctionnement.
Les séquences sont à répéter en fonction du nombre de sources.
Au boulot.
 

Pièces jointes

  • Z.xlsx
    13.7 KB · Affichages: 14
  • 2.xlsx
    14.1 KB · Affichages: 8
  • 3.xlsx
    14.2 KB · Affichages: 7
  • 1.xlsx
    14.2 KB · Affichages: 7
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonsoir AKOLIAI, le forum,

Téléchargez les fichiers joints dans le même dossier (le bureau).

La macro affectée au bouton :
VB: 
Sub Recap()
Dim chemin$, fichier$, feuil$, lig&, nf$, form$, ncol As Variant, ncol1 As Variant
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "*.xlsx") '1er fichier du dossier
feuil = "Feuil1" 'nom des feuilles à copier
lig = 1 '1ère ligne de destination, à adapter
Application.ScreenUpdating = False
With Sheets("Recap") 'à adapter
    .Rows(lig & ":" & .Rows.Count).ClearContents 'RAZ
    While fichier <> ""
        nf = Left(fichier, Len(fichier) - 5)
        If nf = CStr(Int(Val(nf))) Then
            form = "'" & chemin & "[" & fichier & "]" & feuil & "'!R1"
            ncol = ExecuteExcel4Macro("MATCH(""zzz""," & form & ")")
            ncol1 = ExecuteExcel4Macro("MATCH(9^99," & form & ")")
            If IsError(ncol) Then ncol = 1
            If IsError(ncol1) Then ncol1 = 1
            If ncol1 > ncol Then ncol = ncol1
            With Cells(lig, 1).Resize(, ncol)
                .FormulaArray = "=" & form & "C1:R1C" & ncol 'formule matricielle
                .Value = .Value 'supprime la formule
            End With
            lig = lig + 1
        End If
        fichier = Dir
    Wend
    .UsedRange.Replace 0, "", xlWhole 'supprime les valeurs zéro
End With
End Sub
Les cellules sources sont copiées par des formules de liaison, sans ouvrir les fichiers.

Bonne nuit.
 

Pièces jointes

  • Recap(1).xlsm
    18.3 KB · Affichages: 8
  • 1.xlsx
    8.5 KB · Affichages: 6
  • 2.xlsx
    8.5 KB · Affichages: 7
  • 3.xlsx
    8.5 KB · Affichages: 7
Dernière édition:
Vote positif 0 Vote négatif
A

AKOLIAI

XLDnaute Nouveau
job75 à dit:
Bonsoir AKOLIAI, le forum,

Téléchargez les fichiers joints dans le même dossier (le bureau).

La macro affectée au bouton :
VB: 
Sub Recap()
Dim chemin$, fichier$, feuil$, lig&, nf$, form$, ncol As Variant, ncol1 As Variant
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "*.xlsx") '1er fichier du dossier
feuil = "Feuil1" 'nom des feuilles à copier
lig = 1 '1ère ligne de destination, à adapter
Application.ScreenUpdating = False
With Sheets("Recap") 'à adapter
    .Rows(lig & ":" & .Rows.Count).ClearContents 'RAZ
    While fichier <> ""
        nf = Left(fichier, Len(fichier) - 5)
        If nf = CStr(Int(Val(nf))) Then
            form = "'" & chemin & "[" & fichier & "]" & feuil & "'!R1"
            ncol = ExecuteExcel4Macro("MATCH(""zzz""," & form & ")")
            ncol1 = ExecuteExcel4Macro("MATCH(9^99," & form & ")")
            If IsError(ncol) Then ncol = 1
            If IsError(ncol1) Then ncol1 = 1
            If ncol1 > ncol Then ncol = ncol1
            With Cells(lig, 1).Resize(, ncol)
                .FormulaArray = "=" & form & "C1:R1C" & ncol 'formule matricielle
                .Value = .Value 'supprime la formule
            End With
            lig = lig + 1
        End If
        fichier = Dir
    Wend
    .UsedRange.Replace 0, "", xlWhole 'supprime les valeurs zéro
End With
End Sub
Les cellules sources sont copiées par des formules de liaison, sans ouvrir les fichiers.

Bonne nuit.
Cliquez pour agrandir...
Bonjour Job75,
Ta réponse est parfaite,
Une autre question complexe,
la macro que tu me présente fait directement un copier de toute la ligne, et elle n'écrase pas les données, c'est parfait,
J'ai une seconde demande, c'est que je ne souhaite pas copier toute la ligne du fichier 1, 2 ou 3,
Je souhaite récupérer des valeur de 5 ou 6 cellules, qui sont dans le meme onglet,
Exemple je souhaite copier les valeur de la cellule (A1), (B1) et (F1) par exemple et les coller directement dans le fichier recap sur la meme ligne en A1 et B1 et C1 par exemple,

Est ce que c'est faisable ?

Merci
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour AKOLIAI, le forum,
AKOLIAI à dit:
je souhaite copier les valeur de la cellule (A1), (B1) et (F1) par exemple et les coller directement dans le fichier recap
Cliquez pour agrandir...
C'est plus simple, voyez ce fichier (2) et la macro :
VB: 
Sub Recap()
Dim chemin$, fichier$, feuil$, col, ub%, lig&, nf$, form$, i As Byte
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "*.xlsx") '1er fichier du dossier
feuil = "Feuil1" 'nom des feuilles à copier
col = Array(1, 2, 6) 'numéros des colonnes à copier (A B F)
ub = UBound(col)
lig = 1 '1ère ligne de destination, à adapter
Application.ScreenUpdating = False
With Sheets("Recap") 'à adapter
    .Rows(lig & ":" & .Rows.Count).ClearContents 'RAZ
    While fichier <> ""
        nf = Left(fichier, Len(fichier) - 5)
        If nf = CStr(Int(Val(nf))) Then
            form = "='" & chemin & "[" & fichier & "]" & feuil & "'!R1C"
            For i = 0 To ub
                With Cells(lig, i + 1)
                    .FormulaR1C1 = form & col(i) 'formule de liaison
                    .Value = .Value 'supprime la formule
                End With
            Next
            lig = lig + 1
        End If
        fichier = Dir
    Wend
    .UsedRange.Replace 0, "", xlWhole 'supprime les valeurs zéro
End With
End Sub
A+
 

Pièces jointes

  • Recap(2).xlsm
    18.9 KB · Affichages: 5
  • 1.xlsx
    8.5 KB · Affichages: 3
  • 2.xlsx
    8.5 KB · Affichages: 4
  • 3.xlsx
    8.5 KB · Affichages: 2
Vote positif 0 Vote négatif
A

AKOLIAI

XLDnaute Nouveau
job75 à dit:
Bonjour AKOLIAI, le forum,

C'est plus simple, voyez ce fichier (2) et la macro :
VB: 
Sub Recap()
Dim chemin$, fichier$, feuil$, col, ub%, lig&, nf$, form$, i As Byte
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "*.xlsx") '1er fichier du dossier
feuil = "Feuil1" 'nom des feuilles à copier
col = Array(1, 2, 6) 'numéros des colonnes à copier (A B F)
ub = UBound(col)
lig = 1 '1ère ligne de destination, à adapter
Application.ScreenUpdating = False
With Sheets("Recap") 'à adapter
    .Rows(lig & ":" & .Rows.Count).ClearContents 'RAZ
    While fichier <> ""
        nf = Left(fichier, Len(fichier) - 5)
        If nf = CStr(Int(Val(nf))) Then
            form = "='" & chemin & "[" & fichier & "]" & feuil & "'!R1C"
            For i = 0 To ub
                With Cells(lig, i + 1)
                    .FormulaR1C1 = form & col(i) 'formule de liaison
                    .Value = .Value 'supprime la formule
                End With
            Next
            lig = lig + 1
        End If
        fichier = Dir
    Wend
    .UsedRange.Replace 0, "", xlWhole 'supprime les valeurs zéro
End With
End Sub
A+
Cliquez pour agrandir...
Merci, mais est ce que ça fonction sur un grand nombre de fichiers qui sont dans le memes dossier par exemple, la macro va scruter tous les fichiers et elle récupere les infos sans ecraser les lignes ?
Merci par avance de votre précisuese aide
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Je ne vois pas ce que vous voulez dire, le nombre de fichiers n'a pas d'importance.

Mais prenez ce fichier (3), la macro est plus rapide car les formules sont supprimées en bloc :
VB: 
Sub Recap()
Dim chemin$, fichier$, feuil$, col, ub%, lig&, nf$, form$, i%
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "*.xlsx") '1er fichier du dossier
feuil = "Feuil1" 'nom des feuilles à copier
col = Array(1, 2, 6) 'numéros des colonnes à copier (A B F)
ub = UBound(col)
lig = 1 '1ère ligne de destination, à adapter
Application.ScreenUpdating = False
With Sheets("Recap") 'à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Rows(lig & ":" & .Rows.Count).ClearContents 'RAZ
    While fichier <> ""
        nf = Left(fichier, Len(fichier) - 5)
        If nf = CStr(Int(Val(nf))) Then
            form = "='" & chemin & "[" & fichier & "]" & feuil & "'!R1C"
            For i = 0 To ub
                Cells(lig, i + 1) = form & col(i) 'formule de liaison
            Next
            lig = lig + 1
        End If
        fichier = Dir
    Wend
    .UsedRange = .UsedRange.Value 'supprime les formules
    .UsedRange.Replace 0, "", xlWhole 'supprime les valeurs zéro
End With
End Sub
 

Pièces jointes

  • Recap(3).xlsm
    17.8 KB · Affichages: 4
Vote positif 0 Vote négatif
A

AKOLIAI

XLDnaute Nouveau
job75 à dit:
J'ai testé la dernière macro ave 500 fichiers sources : l'exécution se fait chez moi en 2,3 secondes.

Edit : en fait la macro du fichier (3) n'est pas plus rapide que celle du fichier (2).
Cliquez pour agrandir...
Super,
J'ai une dernière demande à faire,
c'est avec la meme macro si vraiment je peux choisir les cellule a copier dans le fichier recap,
Exemple :
J'ai N fichier excel qui ont la meme structure qui sont dans le meme dossier,
Je veux prendre dans chaque fichier Excel la valeur de la cellule B2 de la feuille 1 et la cellule F3 de la feuille 2 et la cellule E9 de la feuille 3 par exemple et les copier sur une meme ligne par ordre dans je viens de citer ?
et cela se refait pour tout les fichier Excel,
ya moyen d'adapter ta dernière MACRO,

Merci pour ton aide,

Cordialement
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Pas compliqué si l'on a bien compris comment construire les formules de liaison :
VB: 
Sub Recap()
Dim chemin$, fichier$, cellule, ub%, lig&, nf$, form$, i%
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "*.xlsx") '1er fichier du dossier
cellule = Array("Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9") 'feuilles et cellules à copier, attention aux apostrophes
ub = UBound(cellule)
lig = 1 '1ère ligne de destination, à adapter
Application.ScreenUpdating = False
With Sheets("Recap") 'à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Rows(lig & ":" & .Rows.Count).ClearContents 'RAZ
    While fichier <> ""
        nf = Left(fichier, Len(fichier) - 5)
        If nf = CStr(Int(Val(nf))) Then
            form = "='" & chemin & "[" & fichier & "]"
            For i = 0 To ub
                Cells(lig, i + 1) = form & cellule(i) 'formule de liaison
            Next
            lig = lig + 1
        End If
        fichier = Dir
    Wend
    .UsedRange = .UsedRange.Value 'supprime les formules
    .UsedRange.Replace 0, "", xlWhole 'supprime les valeurs zéro
End With
End Sub
 

Pièces jointes

  • Recap(4).xlsm
    19.1 KB · Affichages: 7
  • 1.xlsx
    10 KB · Affichages: 6
  • 2.xlsx
    10 KB · Affichages: 5
Vote positif 0 Vote négatif
A

AKOLIAI

XLDnaute Nouveau
job75 à dit:
Pas compliqué si l'on a bien compris comment construire les formules de liaison :
VB: 
Sub Recap()
Dim chemin$, fichier$, cellule, ub%, lig&, nf$, form$, i%
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "*.xlsx") '1er fichier du dossier
cellule = Array("Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9") 'feuilles et cellules à copier, attention aux apostrophes
ub = UBound(cellule)
lig = 1 '1ère ligne de destination, à adapter
Application.ScreenUpdating = False
With Sheets("Recap") 'à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Rows(lig & ":" & .Rows.Count).ClearContents 'RAZ
    While fichier <> ""
        nf = Left(fichier, Len(fichier) - 5)
        If nf = CStr(Int(Val(nf))) Then
            form = "='" & chemin & "[" & fichier & "]"
            For i = 0 To ub
                Cells(lig, i + 1) = form & cellule(i) 'formule de liaison
            Next
            lig = lig + 1
        End If
        fichier = Dir
    Wend
    .UsedRange = .UsedRange.Value 'supprime les formules
    .UsedRange.Replace 0, "", xlWhole 'supprime les valeurs zéro
End With
End Sub
Cliquez pour agrandir...
Job75
Merci pour ton aide,
ça marche,
mais je souhaiterais mettre autant de cellule dans
cellule = Array("Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9") mais à un moment donnée ça me bloque et je ne peux pas ajouter de cellule, est ce que dans VBA c'est limité ou non ? par exemple si je souhaite copier 39 cellules, est cela est faisable ?
Merci par avance de ton aide
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonsoir AKOUAI,

Chez moi un Array avec les adresses de 39 cellules ne pose pas de problème.

Mais bien sûr il faut écrire l'instruction sur plusieurs lignes :
VB: 
cellule = Array("Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9") 'feuilles et cellules à copier, attention aux apostrophes
A+
 
Vote positif 0 Vote négatif
A

AKOLIAI

XLDnaute Nouveau
job75 à dit:
Bonsoir AKOUAI,

Chez moi un Array avec les adresses de 39 cellules ne pose pas de problème.

Mais bien sûr il faut écrire l'instruction sur plusieurs lignes :
VB: 
cellule = Array("Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9", _
                "Feuil1'!B2", "Feuil2'!F3", "Feuil3'!E9") 'feuilles et cellules à copier, attention aux apostrophes
A+
Cliquez pour agrandir...
Thank you so much
 
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
XL 2021 Macro copier dans un fichier Excel sur Sharepoint
Réponses
1
Affichages
165
vgendron
vgendron
E
  • Question
Microsoft 365 Couleurs de fichiers qui changent
Réponses
1
Affichages
224
mapomme
mapomme
P
  • Résolu(e)
XL 2021 Besoin d'aide pour copier/coller données de plusieurs classeurs
2
Réponses
20
Affichages
575
Pac41240
P
M
  • Question
XL 2021 Creation VBA copie de differents fichiers dans différents dossiers
Réponses
5
Affichages
331
patricktoulon
patricktoulon
E
  • Question
Microsoft 365 Fusionner 2 fichiers excel avec nom spécifique
Réponses
5
Affichages
339
Erakmur
E
J
  • Question
Microsoft 365 Conversion de fichiers word en pdf / VBA
Réponses
1
Affichages
397
kiki29
kiki29
R
  • Résolu(e)
XL 2016 Créer un .doc à partir des données d'un tableur
Réponses
9
Affichages
256
job75
job75
P
  • Question
Microsoft 365 copier coller un onglet dans un autre fichier
Réponses
6
Affichages
492
pralo
P
M
  • Question
XL 2019 Copier des lignes les unes a la suite des autres dans une autre feuille sous conditions et seulement certaines colonnes
Réponses
7
Affichages
573
MGH
M
jeff1494
  • Question
XL 2021 Liste des propriétés de fichiers.
3 4 5
Réponses
73
Affichages
3 K
jeff1494
jeff1494

Membres actuellement en ligne

12 membres et 136 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 651
Messages
2 111 553
Membres
111 199
dernier inscrit
mavoungou regis