Note: The other languages of the website are Google-translated. Back to English
English English

Comment parcourir des fichiers dans un répertoire et copier des données dans une feuille maître dans Excel?

En supposant qu'il y ait plusieurs classeurs Excel dans un dossier et que vous souhaitiez parcourir tous ces fichiers Excel et copier les données d'une plage spécifiée de feuilles de calcul du même nom dans une feuille de calcul principale dans Excel, que pouvez-vous faire? Cet article présente une méthode pour y parvenir en détail.

Parcourez les fichiers d'un répertoire et copiez les données dans une feuille principale avec le code VBA


Parcourez les fichiers d'un répertoire et copiez les données dans une feuille principale avec le code VBA


Si vous souhaitez copier des données spécifiées dans la plage A1: D4 de toutes les feuilles1 des classeurs d'un certain dossier vers une feuille maître, procédez comme suit.

1. Dans le classeur, vous allez créer une feuille de calcul principale, appuyez sur la touche autre + F11 clés pour ouvrir le Microsoft Visual Basic pour applications fenêtre.

2. dans le Microsoft Visual Basic pour applications fenêtre, cliquez sur insérer > Module. Copiez ensuite le code VBA ci-dessous dans la fenêtre de code.

Code VBA: parcourez les fichiers d'un dossier et copiez les données dans une feuille principale

Sub Merge2MultiSheets()
    Dim xRg As Range
    Dim xSelItem As Variant
    Dim xFileDlg As FileDialog
    Dim xFileName, xSheetName, xRgStr As String
    Dim xBook, xWorkBook As Workbook
    Dim xSheet As Worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    xSheetName = "Sheet1"
    xRgStr = "A1:D4"
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    With xFileDlg
        If .Show = -1 Then
            xSelItem = .SelectedItems.Item(1)
            Set xWorkBook = ThisWorkbook
            Set xSheet = xWorkBook.Sheets("New Sheet")
            If xSheet Is Nothing Then
                xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.Count)).Name = "New Sheet"
                Set xSheet = xWorkBook.Sheets("New Sheet")
            End If
            xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
            If xFileName = "" Then Exit Sub
            Do Until xFileName = ""
               Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
                Set xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
                xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
                xFileName = Dir()
                xBook.Close
            Loop
        End If
    End With
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Remarque :

1). Dans le code, "A1: D4" et "Sheet1”Signifie que les données de la plage A1: D4 de toutes les feuilles Sheet1 seront copiées dans la feuille principale. Et "Nouvelle feuille»Est le nom de la nouvelle feuille maître créée.
2). Les fichiers Excel dans le dossier spécifique ne doivent pas s'ouvrir.

3. appuie sur le F5 clé pour exécuter le code.

4. Dans l'ouverture DECOUVREZ , sélectionnez le dossier contenant les fichiers que vous parcourez en boucle, puis cliquez sur le OK bouton. Voir la capture d'écran:

Ensuite, une feuille de calcul principale nommée «Nouvelle feuille» est créée à la fin du classeur en cours. Et les données de la plage A1: D4 de toutes les feuilles Sheet1 du dossier sélectionné sont répertoriées dans la feuille de calcul.


Articles Liés:


Les meilleurs outils de productivité de bureau

Kutools for Excel résout la plupart de vos problèmes et augmente votre productivité de 80%

  • Réutilisation: Insérer rapidement formules complexes, graphiques et tout ce que vous avez utilisé auparavant; Crypter les cellules avec mot de passe; Créer une liste de diffusion et envoyer des e-mails ...
  • Barre Super Formula (modifiez facilement plusieurs lignes de texte et de formule); Disposition de lecture (lire et modifier facilement un grand nombre de cellules); Coller dans la plage filtréeplus
  • Fusionner les cellules / lignes / colonnes sans perdre de données; Contenu des cellules divisées; Combiner des lignes / colonnes en double... Empêcher les cellules en double; Comparer les gammesplus
  • Sélectionnez Dupliquer ou Unique Lignes; Sélectionnez les lignes vides (toutes les cellules sont vides); Super Find et Fuzzy Find dans de nombreux classeurs; Sélection aléatoire ...
  • Copie exacte Plusieurs cellules sans changer la référence de formule; Créer automatiquement des références à plusieurs feuilles; Insérer des puces, Cases à cocher et plus encore ...
  • Extrait du texte, Ajouter du texte, Supprimer par position, Supprimer l'espace; Créer et imprimer des sous-totaux de pagination; Conversion entre le contenu et les commentaires des cellulesplus
  • Super filtre (enregistrer et appliquer des schémas de filtrage à d'autres feuilles); Tri avancé par mois / semaine / jour, fréquence et plus; Filtre spécial par gras, italique ...
  • Combiner des classeurs et des feuilles de travail; Fusionner les tableaux en fonction des colonnes clés; Diviser les données en plusieurs feuilles; Conversion par lots xls, xlsx et PDFplus
  • Plus de 300 fonctionnalités puissantes. Prend en charge Office / Excel 2007-2019 et 365. Prend en charge toutes les langues. Déploiement facile dans votre entreprise ou organisation. Essai gratuit de 30 jours. Garantie de remboursement de 60 jours.
onglet kte 201905

Office Tab apporte une interface à onglets à Office et simplifie considérablement votre travail

  • Activer l'édition et la lecture par onglets dans Word, Excel, PowerPoint, Publisher, Access, Visio et Project.
  • Ouvrez et créez plusieurs documents dans de nouveaux onglets de la même fenêtre, plutôt que dans de nouvelles fenêtres.
  • Augmente votre productivité de 50% et réduit des centaines de clics de souris chaque jour!
bas de cabine
Commentaires (17)
Pas encore de notes. Soyez le premier à évaluer!
Ce commentaire a été minimisé par le modérateur sur le site
merci pour le code vba! Cela fonctionne parfaitement ! J'aimerais savoir quel est le code si j'ai besoin de COLLER COMME VALEUR à la place ? Merci d'avance !
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Lai Ling,
Le code suivant peut vous aider à résoudre le problème. Merci pour votre commentaire.

Sub Merge2MultiSheets()
Dim xRg As Range
Dim xSelItem As Variant
Dim xFileDlg As FileDialog
Dim xFileName, xSheetName, xRgStr As String
Dim xBook, xWorkBook comme classeur
Dim xSheet en tant que feuille de calcul
On Error Resume Next
Application.DisplayAlerts = Faux
Application.EnableEvents = False
Application.ScreenUpdating = Faux
xSheetName = "Sheet1"
xRgStr = "A1:D4"
Définir xFileDlg = Application. FileDialog (msoFileDialogFolderPicker)
Avec xFileDlg
Si .Show = -1 Alors
xSelItem = .SelectedItems.Item(1)
Définir xWorkBook = ThisWorkbook
Set xSheet = xWorkBook.Sheets("Nouvelle Feuille")
Si xSheet n'est rien alors
xWorkBook.Sheets.Add(after :=xWorkBook.Worksheets(xWorkBook.Worksheets.count)).Name = "Nouvelle feuille"
Set xSheet = xWorkBook.Sheets("Nouvelle Feuille")
Si fin
xNomFichier = Dir(xSelItem & "\*.xlsx", vbNormal)
Si xFileName = "" alors quitter le sous-marin
Faire jusqu'à xFileName=""
Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
Définir xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
xNomFichier = Dir()
xBook.Fermer
boucle
Si fin
Terminer par
Définir xRg = xSheet.UsedRange
xRg.ClearFormatsxRg.ClearFormats
xRg.UseStandardHeight = Vrai
xRg.UseStandardWidth = Vrai
Application.DisplayAlerts = Vrai
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Salut, merci pour le code. Pouvez-vous me dire comment je peux inclure le nom du fichier Excel à partir duquel la plage de données a été copiée ? Ce serait d'une grande aide !

Thank you.
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour,

Merci pour le tutoriel.

Comment pourrais-je : copier uniquement la ligne dans "Sheet1" avec les valeurs de la ligne "total" et coller avec [filename] dans la feuille de calcul principale nommée "New Sheet". Notez que la ligne avec Total peut être différente dans chaque feuille de calcul.

Par exemple :
Fichier1 : Feuille1
Col1, Col2, Colx
1,2,15
Résultat,10,50

Fichier2 : Feuille1
Col1, Col2, Colx
1,5,10
2,4,16
3,3,6
4,5,6
5,7,10
Résultat,300,500

MasterFile : "Nouvelle feuille":
fichier1, 10, 50
fichier2, 300, 500
Ce commentaire a été minimisé par le modérateur sur le site
Salut, Cela fonctionne très bien. Existe-t-il un moyen de modifier simplement les valeurs et non la formule?
Merci!!
Ce commentaire a été minimisé par le modérateur sur le site
Salut Trish,
Le code suivant peut vous aider à résoudre le problème. Merci pour votre commentaire.

Sub Merge2MultiSheets()
Dim xRg As Range
Dim xSelItem As Variant
Dim xFileDlg As FileDialog
Dim xFileName, xSheetName, xRgStr As String
Dim xBook, xWorkBook comme classeur
Dim xSheet en tant que feuille de calcul
On Error Resume Next
Application.DisplayAlerts = Faux
Application.EnableEvents = False
Application.ScreenUpdating = Faux
xSheetName = "Sheet1"
xRgStr = "A1:D4"
Définir xFileDlg = Application. FileDialog (msoFileDialogFolderPicker)
Avec xFileDlg
Si .Show = -1 Alors
xSelItem = .SelectedItems.Item(1)
Définir xWorkBook = ThisWorkbook
Set xSheet = xWorkBook.Sheets("Nouvelle Feuille")
Si xSheet n'est rien alors
xWorkBook.Sheets.Add(after :=xWorkBook.Worksheets(xWorkBook.Worksheets.count)).Name = "Nouvelle feuille"
Set xSheet = xWorkBook.Sheets("Nouvelle Feuille")
Si fin
xNomFichier = Dir(xSelItem & "\*.xlsx", vbNormal)
Si xFileName = "" alors quitter le sous-marin
Faire jusqu'à xFileName=""
Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
Définir xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
xNomFichier = Dir()
xBook.Fermer
boucle
Si fin
Terminer par
Définir xRg = xSheet.UsedRange
xRg.ClearFormatsxRg.ClearFormats
xRg.UseStandardHeight = Vrai
xRg.UseStandardWidth = Vrai
Application.DisplayAlerts = Vrai
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Salut, ça tire toujours les formules, pas les valeurs, donc ça me donne une erreur #REF. Je sais qu'il pourrait avoir besoin d'un .PasteSpecial xlPasteValues ​​quelque part, mais je ne sais pas où. Pouvez-vous aider ? Merci!
Ce commentaire a été minimisé par le modérateur sur le site
Salut Merci pour cela.


Comment puis-je inclure le code pour parcourir tous les dossiers et sous-dossiers et effectuer la copie ci-dessus ?


Merci !
Ce commentaire a été minimisé par le modérateur sur le site
Salut - Ce code est parfait pour ce que j'essaie de réaliser.

Existe-t-il un moyen de parcourir tous les dossiers et sous-dossiers et d'effectuer la copie ?


Merci !
Ce commentaire a été minimisé par le modérateur sur le site
Salut - Ce code fonctionne très bien pour les 565 premières lignes de chaque fichier, mais toutes les lignes suivantes sont recouvertes par le fichier suivant.
Y'a t'il un moyen d'arranger cela?
Ce commentaire a été minimisé par le modérateur sur le site
Merci - comment pourrait-on copier et coller (valeurs spéciales) de chaque feuille de calcul dans un classeur dans des feuilles séparées dans un fichier maître principal ?
Ce commentaire a été minimisé par le modérateur sur le site
comment faites-vous pour que le code laisse un blanc si la cellule est vide?
Ce commentaire a été minimisé par le modérateur sur le site
pour moi, le nom de l'onglet "Sheet1" change pour chacun de mes fichiers. Par exemple, Tab1, Tab2, Tab3, Tab4... Comment puis-je configurer une boucle pour parcourir une liste dans Excel et continuer à changer le nom "Sheet1" jusqu'à ce qu'il parcourt tout ?
Ce commentaire a été minimisé par le modérateur sur le site
Salut Nick, Le code VBA ci-dessous peut vous aider à résoudre le problème. Veuillez essayer. Sous LoopThroughFileRename()
'Mise à jour par Extendofice 2021/12/31
Dim xRg As Range
Dim xSelItem As Variant
Dim xFileDlg As FileDialog
Dim xFileName, xSheetName, xRgStr As String
Dim xBook, xWorkBook comme classeur
Dim xSheet en tant que feuille de calcul
Dim xShs As Sheets
Dim xName As String
Dim xFNum en tant qu'entier
On Error Resume Next
Application.DisplayAlerts = Faux
Application.EnableEvents = False
Application.ScreenUpdating = Faux
Définir xFileDlg = Application. FileDialog (msoFileDialogFolderPicker)
xFileDlg.Show
xSelItem = xFileDlg.SelectedItems.Item(1)
xNomFichier = Dir(xSelItem & "\*.xlsx", vbNormal)
Faire tant que xNomFichier <> ""
Définir xWorkBook = Workbooks.Open(xSelItem & "\" & xFileName)
Définir xShs = xWorkBook.Sheets
Pour xFNum = 1 à xShs.Count
Définir xSheet = xShs.Item(xFNum)
xName = xSheet.Name
xName = Remplacer(xName, "feuille""Languette") 'Remplacer la feuille par l'onglet
xFeuille.Nom = xNom
Suivant
xWorkBook.Save
xWorkBook.Fermer
xNomFichier = Dir()
boucle
Application.DisplayAlerts = Vrai
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Salut, je veux un code pour copier les données dans 6 classeurs différents (dans un dossier) contenant des feuilles incluses dans NEW WORKBOOK. en vba
svp aidez moi asp
Ce commentaire a été minimisé par le modérateur sur le site
Salut Paranusha,
Le script VBA de l'article suivant peut combiner plusieurs classeurs ou feuilles de classeurs spécifiées dans un classeur principal. Veuillez vérifier si cela peut aider.
Comment combiner plusieurs classeurs en un seul classeur principal dans Excel ?
Ce commentaire a été minimisé par le modérateur sur le site
Ola Bom Dia.
Gostei muito dessde código, mas não me ajudou com os relatórios que eu preciso impreimir.
Preciso imprimir 2.400 relatório de exel que estão em pastas diferentes e não estão configuradas corretamente para impressão. Pode me enviar um códgo de VBA que automatize essas impressões ? Me ajudaria muito, obrigada.
Il n'y a pas encore de commentaires postés ici
Laisser vos commentaires
Publier en tant qu'invité
×
Évaluez cet article:
0   Personnages
Emplacements suggérés