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

Comment exécuter une macro en même temps sur plusieurs fichiers de classeur?

Cet article, je vais expliquer comment exécuter une macro sur plusieurs fichiers de classeur en même temps sans les ouvrir. La méthode suivante peut vous aider à résoudre cette tâche dans Excel.

Exécutez une macro en même temps sur plusieurs classeurs avec le code VBA


Exécutez une macro en même temps sur plusieurs classeurs avec le code VBA

Pour exécuter une macro sur plusieurs classeurs sans les ouvrir, veuillez appliquer le code VBA suivant:

1. Maintenez le ALT + F11 clés pour ouvrir le Microsoft Visual Basic pour applications fenêtre.

2Cliquez sur insérer > Moduleet collez la macro suivante dans le Module Fenêtre.

Code VBA: exécutez la même macro sur plusieurs classeurs en même temps:

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
            End With
            xFileName = Dir
        Loop
    End If
End Sub

Notes: Dans le code ci-dessus, veuillez copier et coller votre propre code sans le Sol cap et End Sub pied de page entre le Avec Workbooks.Open (xFdItem & xFileName) et Terminer par scripts. Voir la capture d'écran:

doc exécuter la macro plusieurs fichiers 1

3. Puis appuyez F5 clé pour exécuter ce code, et un DECOUVREZ fenêtre s'affiche, veuillez sélectionner un dossier contenant les classeurs que vous souhaitez tous appliquer cette macro, voir capture d'écran:

doc exécuter la macro plusieurs fichiers 2

4. Et puis cliquez OK bouton, la macro souhaitée sera exécutée à la fois d'un classeur à d'autres.

 


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-2021 et 365. Prend en charge toutes les langues. Déploiement facile dans votre entreprise ou organisation. Fonctionnalités complètes 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 (43)
Noté 4.5 hors 5 · évaluations 1
Ce commentaire a été minimisé par le modérateur sur le site
Macro très utile, et elle fonctionne bien, mais j'aimerais pouvoir sélectionner les fichiers de ce dossier sur lesquels je veux que la macro soit exécutée ? Les fichiers ne sont pas générés automatiquement dans un dossier séparé et je dois exécuter différentes macros sur chaque ensemble de fichiers de ce dossier, puis les replacer dans le dossier initial.
Ce commentaire a été minimisé par le modérateur sur le site
J'ai suivi les instructions mais j'obtiens une erreur de compilation "Loop withtout Do". Qu'est-ce que je rate? Mon code de macro est très simple, il suffit de changer la taille de la police des lignes spécifiées. Fonctionne par lui-même. Voici ce que j'ai ... aidez-moi s'il vous plaît

Sous LoopThroughFiles()
Boîte de dialogue Dim xFd en tant que fichier
Dim xFdItem comme variante
Estomper xFileName en tant que chaîne
Définir xFd = Application. FileDialog (msoFileDialogFolderPicker)
Si xFd.Show = -1 Alors
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xNomFichier = Dir(xFdItem & "*.xls*")
Faire tant que xNomFichier <> ""
Avec Workbooks.Open (xFdItem & xFileName)
'votre code ici
Lignes("2:8").Sélectionnez
Avec sélection.Font
.Name = "Arial"
.Taille = 12
.Barré = Faux
.Exposant = Faux
.Indice = Faux
.OutlineFont = Faux
.Ombre = Faux
.Underline = xlUnderlineStyleNone
.Couleur = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
Terminer par
xNomFichier = Répertoire
boucle
Si fin
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Yarto,
Vous avez manqué le script "End with" à la fin de votre code, le bon devrait être celui-ci :
Sous LoopThroughFiles()
Boîte de dialogue Dim xFd en tant que fichier
Dim xFdItem comme variante
Estomper xFileName en tant que chaîne
Définir xFd = Application. FileDialog (msoFileDialogFolderPicker)
Si xFd.Show = -1 Alors
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xNomFichier = Dir(xFdItem & "*.xls*")
Faire tant que xNomFichier <> ""
Avec Workbooks.Open (xFdItem & xFileName)
'votre code ici
Lignes("2:8").Sélectionnez
Avec sélection.Font
.Name = "Arial"
.Taille = 16
.Barré = Faux
.Exposant = Faux
.Indice = Faux
.OutlineFont = Faux
.Ombre = Faux
.Underline = xlUnderlineStyleNone
.Couleur = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
Terminer par
Terminer par
xNomFichier = Répertoire
boucle
Si fin
End Sub

S'il vous plaît essayez-le, j'espère que cela peut vous aider!
Ce commentaire a été minimisé par le modérateur sur le site
Macro très utile, et elle fonctionne très bien, mais j'aimerais pouvoir sélectionner les fichiers de ce dossier sur lesquels je veux que la macro soit exécutée ? Par exemple, j'ai 4 fichiers dans un dossier avec d'autres fichiers Excel et je veux seulement qu'il soit exécuté sur ces 4 fichiers spécifiques. Comment puis-je modifier votre macro pour me permettre de choisir ces 4 fichiers dans ce dossier ?
Ce commentaire a été minimisé par le modérateur sur le site
Salut, Joël,
Pour déclencher le même code dans des classeurs spécifiques, vous devez appliquer le code ci-dessous :

Sous LoopThroughFiles()
Boîte de dialogue Dim xFd en tant que fichier
Dim xFdItem comme variante
Estomper xFileName en tant que chaîne
Dim xFB en tant que chaîne
Avec Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = Vrai
.Filtres.Effacer
.Filtres.Ajouter "excel", "*.xls*"
.Spectacle
Si .SelectedItems.Count < 1 Alors Quittez Sub
Pour lngCount = 1 Pour .SelectedItems.Count
xFileName = .SelectedItems(lngCount)
Si xNomFichier <> "" Alors
Avec Workbooks.Open(Filename:=xFileName)
'votre code
Terminer par
Si fin
Compte lng suivant
Terminer par
End Sub

S'il vous plaît essayez-le, j'espère que cela peut vous aider!
Ce commentaire a été minimisé par le modérateur sur le site
merci, c'était vraiment utile
Ce commentaire a été minimisé par le modérateur sur le site
Hello!

J'essaie d'insérer mon code dans le vôtre et lorsque j'exécute la macro, il me donne le message suivant : Erreur d'exécution '429' : ActiveX ne peut pas créer l'objet. S'il vous plaît avisé sur la façon dont il peut être fixé. Merci!

Mon code:

Définir RInput = Range("A2:A21")
Définir RSortie = Plage("D2:D22")

Dim A() comme variante
Redim A(1 à RInput.Rows.Count, 0)
A = RIntrée.Valeur2

Set d = CreateObject("Scripsting.Dictionary")

Pour i = 1 Vers UBound(A)
Si d.Existe(A(i, 1)) Alors
d(UNE(je, 1)) = d(UNE(je, 1)) + 1
autre
d.Ajouter A(i, 1), 1
Si fin
Suivant
Pour i = 1 Vers UBound(A)
A(je, 1) = d(A(i, 1))
Suivant

RSortie = A
Ce commentaire a été minimisé par le modérateur sur le site
Salut, tout d'abord merci pour cette macro, c'est exactement ce que je cherchais. J'ai cependant un problème, existe-t-il un moyen de fermer et d'enregistrer chaque fenêtre à mesure qu'elle se termine. J'ai une grande quantité de fichiers et je manque de RAM avant la fin de l'exécution.
Ce commentaire a été minimisé par le modérateur sur le site
Oui, ajoutez simplement ci-dessous votre code suivant si vous le souhaitez pour enregistrer le fichier avec le même nom :

'Sauvegarder le classeur
ActiveWorkbook.Sauvegarder
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, Caitline,
Peut-être que le code ci-dessous peut vous aider, chaque fois après avoir exécuté votre code spécifique, une boîte de dialogue d'enregistrement de fichier apparaîtra pour vous rappeler d'enregistrer le classeur.

Sous LoopThroughFiles()
Boîte de dialogue Dim xFd en tant que fichier
Dim xFdItem comme variante
Estomper xFileName en tant que chaîne
Dim xWB comme classeur
Définir xFd = Application. FileDialog (msoFileDialogFolderPicker)
Si xFd.Show = -1 Alors
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xNomFichier = Dir(xFdItem & "*.xls*")
On Error Resume Next
Faire tant que xNomFichier <> ""
Définir xWB = Workbooks.Open(xFdItem & xFileName)
Avec xWB
'votre code ici
Terminer par
xWB.Fermer
xNomFichier = Répertoire
boucle
Si fin
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Hello!

J'essaie d'insérer mon code dans le vôtre et lorsque j'exécute la macro, il me donne le message suivant : Erreur d'exécution '429' : ActiveX ne peut pas créer l'objet. S'il vous plaît avisé sur la façon dont il peut être fixé. Merci!

Mon code:

Définir RInput = Range("A2:A21")
Définir RSortie = Plage("D2:D22")

Dim A() comme variante
Redim A(1 à RInput.Rows.Count, 0)
A = RIntrée.Valeur2

Set d = CreateObject("Scripsting.Dictionary")

Pour i = 1 Vers UBound(A)
Si d.Existe(A(i, 1)) Alors
d(UNE(je, 1)) = d(UNE(je, 1)) + 1
autre
d.Ajouter A(i, 1), 1
Si fin
Suivant
Pour i = 1 Vers UBound(A)
A(je, 1) = d(A(i, 1))
Suivant

RSortie = A
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour,

J'ai utilisé cette macro avec succès pour formater les fichiers NBA pour les 30 équipes chacune avec son propre livre. Hier, j'ai reçu un message d'erreur indiquant que le module (macro) ne peut pas être complété ou supprimé ou modifié (à enregistrer). Il a corrompu mon classeur de macros personnel et rendu Excel pratiquement inutilisable pour moi. Il plante l'application chaque fois que j'essaie d'accéder à une macro à partir de n'importe quel fichier. Le support Excel et le support Windows n'ont pas été capables de réparer les choses. Pouvez-vous aider ?
Ce commentaire a été minimisé par le modérateur sur le site
Salut, Existe-t-il un moyen de définir la destination du fichier dans le script lui-même. Je veux ignorer le processus 3 où nous devons parcourir le dossier spécifique.
Ce commentaire a été minimisé par le modérateur sur le site
Salut, merci pour ce code. pouvez-vous s'il vous plaît me dire comment puis-je avoir le résultat de ma macro pour laquelle j'ai ouvert tous les classeurs dans une feuille (le résultat de chaque classeur d'affilée)? et existe-t-il un moyen d'ajouter le nom de chaque classeur à la ligne avec les données de l'étape précédente ?
Ce commentaire a été minimisé par le modérateur sur le site
Hi

J'ai eu une erreur d'exécution 1004: la syntaxe n'est pas correcte lorsque j'ai exécuté le code suivant qui est le VBA Extend Office pour "Exécuter une macro en même temps sur plusieurs classeurs avec du code VBA" avec le VBA Extend Office "Supprimer toutes les plages nommées avec le code VBA" dans l'insertion de votre emplacement de code :

Sous LoopThroughFiles()

Boîte de dialogue Dim xFd en tant que fichier

Dim xFdItem comme variante

Estomper xFileName en tant que chaîne

Définir xFd = Application. FileDialog (msoFileDialogFolderPicker)

Si xFd.Show = -1 Alors

xFdItem = xFd.SelectedItems(1) & Application.PathSeparator

xNomFichier = Dir(xFdItem & "*.xls*")

Faire tant que xNomFichier <> ""

Avec Workbooks.Open (xFdItem & xFileName)

' Sous SupprimerNoms()

'Mise à jour 20140314

Dim xName comme nom

Pour chaque xName dans Application.ActiveWorkbook.Names

xName.Delete

Suivant


Terminer par

xNomFichier = Répertoire

boucle

Si fin

End Sub

Ce que j'essaie de faire, c'est d'exécuter une macro qui supprime les plages nommées dans huit classeurs contenus dans le même dossier.

BTW, c'est la première fois que j'utilise quelque chose d'Extend Office et cela n'a pas fonctionné. Ce site m'a été extrêmement utile.

Des suggestions/commentaires seraient grandement appréciés.

aldc
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour aldc,
Votre code fonctionne bien dans mon classeur, quelle version d'Excel utilisez-vous ?
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, ce code est tellement bon et utile. Je l'utilise beaucoup!

De nos jours, dans mon organisation, nous utilisons désormais SharePoint pour stocker nos fichiers. Existe-t-il un moyen de faire fonctionner ce code sur tous les fichiers d'un dossier sharepoint ?
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, merci pour ce code.
Existe-t-il également un moyen de parcourir les sous-dossiers ? Disons que j'ai un dossier et dans le dossier dix autres dossiers contenant chacun un fichier Excel.

Existe-t-il un moyen de sélectionner simplement le dossier principal pour que le code s'exécute dans tous ses sous-dossiers ?

Thank you.
Ce commentaire a été minimisé par le modérateur sur le site
Salut, Darko, Pour exécuter un code à partir d'un dossier avec les sous-dossiers, veuillez appliquer le code suivant : Sous-boucle à travers les fichiers_sous-dossiers (xStrPath en tant que chaîne)
Dim xSFolderName
Dim xNomFichier
Dim xArrSFPath() en tant que chaîne
Dim xI sous forme d'entier
Si xStrPath = "" alors quitter le sous-marin
xNomFichier = Dir(xStrPath & "*.xls*")
Faire tant que xNomFichier <> ""
Avec Workbooks.Open(xStrPath & xFileName)
'votre code ici
Terminer par
xNomFichier = Répertoire
boucle
xSFolderName = Dir(xStrPath, vbDirectory)
xI = 0
ReDim xArrSFPath(0)
Faire tant que xSFolderName <> ""
Si xSFolderName <> "." Et xSFolderName <> ".." Alors
Si (GetAttr(xStrPath & xSFolderName) And vbDirectory) = vbDirectory Alors
xI = xI + 1
ReDim Preserve xArrSFPath(xI)
xArrSFPath(xI - 1) = xStrPath & xSFolderName & "\"
Si fin
Si fin
xSFolderName = Dir
boucle
Si UBound(xArrSFPath) > 0 Alors
Pour xI = 0 Vers UBound(xArrSFPath)
LoopThroughFiles_Subfolders (xArrSFPath(xI))
Prochain xI
Si fin
End Sub
Sous LoopThroughFiles()
Boîte de dialogue Dim xFd en tant que fichier
Dim xFdItem comme variante
Estomper xFileName en tant que chaîne
Définir xFd = Application. FileDialog (msoFileDialogFolderPicker)
Si xFd.Show = -1 Alors
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
LoopThroughFiles_Subfolders (xFdItem)
Si fin
End SubVeuillez essayer, j'espère que cela pourra vous aider !
Ce commentaire a été minimisé par le modérateur sur le site
En plus du code ci-dessus, est-il possible d'ouvrir les fichiers Excel dans l'ordre chronologique que je voulais ?
Ce commentaire a été minimisé par le modérateur sur le site
Salut tout d'abord merci beaucoup pour la macro c'est vraiment pratique de travailler avec. Je me demandais simplement si nous avions un moyen d'actualiser le dossier dans le onedrive via la macro . Si oui, pourriez-vous me faire savoir ce que je peux faire ici pour actualiser les fichiers dans onedrive à l'aide d'un script de macro ?
Ce commentaire a été minimisé par le modérateur sur le site
Salut, merci beaucoup pour ce script, je fonctionne très bien pour moi, mais j'ai des besoins particuliers : Existe-t-il un moyen de changer le script pour appliquer mon code avec des conditions de nom de fichier ET dans des sous-dossiers ?
Je m'explique : je suis enseignant et j'ai créé une solution excel pour sauvegarder les résultats des élèves et permettre aux enseignants de les consulter. Pour cela, j'ai un dossier par matière scolaire et un pour le responsable de classe, le tout dans un dossier par classe.
Ainsi, lorsque je trouve un bogue ou une optimisation, je dois signaler les changements dans tous les fichiers de tous les sous-dossiers.
Mais comme tous les fichiers ne sont pas les mêmes (organisation différente des sujets), j'aimerais un moyen d'appliquer mon code par exemple à tous les fichiers nommés "maths class" dans tous les sous-dossiers, ou au contraire, d'appliquer mon code à tous les fichiers dans les sous-dossiers sauf tous les fichiers nommés "xyz". Merci ! Fabrice
Ce commentaire a été minimisé par le modérateur sur le site
Votre code donné ne fonctionne pas avec VBA suivant pouvez-vous s'il vous plaît helpSub Bundles()

Dim vWS en tant que feuille de travail
Variation vA, vA2()
Dim vR As Long, vSum As Long, vC As Long
Dim vN aussi long, vN2 aussi long, vN3 aussi long

Définir vWS = ActiveSheet
Avec vWS
vR = .Cells(Rows.Count, 4).End(xlUp).Row
vSum = Application.Sum(.Range("D2:D" & vR))
Redim Preserve vA2 (1 à vSum, 1 à 4)
vA = .Range("A2:D" & vR)
Pour vN = 1 À vR - 1
Pour vN2 = 1 Vers vA(vN, 4)
vC = vC + 1
Pour vN3 = 1 à 4
vA2(vC, vN3) = vA(vN, vN3)
Prochain vN3
Prochain vN2
Nv suivant
Terminer par
vC = 1
Pour vN = 1 À vSum - 2
vA2(vN, 4) = vC
Si vA2(vN + 1, 2) = vA2(vN, 2) Alors
vC = vC + 1
vA2(vN + 1, 4) = vC
autre
vA2(vN + 1, 4) = 1
vC = 1
Si fin
Nv suivant
Application.ScreenUpdating = Faux
Sheets.add
Avec ActiveSheet
vWS.Range("A1:D1").Copy .Range("A1:D1")
.Cells(2, 1).Resize(vSum, 4) = vA2
Terminer par
Application.ScreenUpdating = True

End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Je veux exécuter ce VBA dans plusieurs feuilles dans un dossier à la fois pouvez-vous s'il vous plaît helpSub Bundles()

Dim vWS en tant que feuille de travail
Variation vA, vA2()
Dim vR As Long, vSum As Long, vC As Long
Dim vN aussi long, vN2 aussi long, vN3 aussi long

Définir vWS = ActiveSheet
Avec vWS
vR = .Cells(Rows.Count, 4).End(xlUp).Row
vSum = Application.Sum(.Range("D2:D" & vR))
Redim Preserve vA2 (1 à vSum, 1 à 4)
vA = .Range("A2:D" & vR)
Pour vN = 1 À vR - 1
Pour vN2 = 1 Vers vA(vN, 4)
vC = vC + 1
Pour vN3 = 1 à 4
vA2(vC, vN3) = vA(vN, vN3)
Prochain vN3
Prochain vN2
Nv suivant
Terminer par
vC = 1
Pour vN = 1 À vSum - 2
vA2(vN, 4) = vC
Si vA2(vN + 1, 2) = vA2(vN, 2) Alors
vC = vC + 1
vA2(vN + 1, 4) = vC
autre
vA2(vN + 1, 4) = 1
vC = 1
Si fin
Nv suivant
Application.ScreenUpdating = Faux
Sheets.add
Avec ActiveSheet
vWS.Range("A1:D1").Copy .Range("A1:D1")
.Cells(2, 1).Resize(vSum, 4) = vA2
Terminer par
Application.ScreenUpdating = True

End Sub
Ce commentaire a été minimisé par le modérateur sur le site
J'ai essayé d'exécuter le code mais l'erreur "424 : Object Required" apparaît à la ligne "With Workbooks.Open(xFdItem & xFileName)". En regardant plus en profondeur, il apparaît que les classeurs Excel stockés dans le dossier d'intérêt ne s'affichent pas/n'existent pas (lorsque la fenêtre s'ouvre avec l'affichage du code, si j'essaie d'ouvrir le dossier et de ne pas le sélectionner, il est vide). Comment?
Sous LoopThroughFiles()
Boîte de dialogue Dim xFd en tant que fichier
Dim xFdItem comme variante
Estomper xFileName en tant que chaîne
Définir xFd = Application. FileDialog (msoFileDialogFolderPicker)
Si xFd.Show = -1 Alors
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xNomFichier = Dir(xFdItem & "*.xls*")
Faire tant que xNomFichier <> ""
Avec Workbooks.Open (xFdItem & xFileName)
Sheets.Add After :=ActiveSheet
Feuilles("Feuille2").Sélectionnez
Feuilles("Feuille2").Nom = "Maître"
Feuilles("Maître").Sélectionnez
Feuilles("Maître").Déplacer avant :=Feuilles(1)
Terminer par
xNomFichier = Répertoire
boucle
Si fin
End Sub


Pouvez-vous s'il vous plaît m'aider à résoudre ce problème?
Ce commentaire a été minimisé par le modérateur sur le site
C'est mon site Web préféré avec les instructions les plus claires (plus que n'importe quelle vidéo YouTube) et j'y reviens sans cesse. Merci beaucoup pour ces tutoriels - vous êtes la bouée de sauvetage d'un étudiant diplômé triste.
Ce commentaire a été minimisé par le modérateur sur le site
Sous LoopThroughFiles()
Boîte de dialogue Dim xFd en tant que fichier
Dim xFdItem comme variante
Estomper xFileName en tant que chaîne
Définir xFd = Application. FileDialog (msoFileDialogFolderPicker)
Si xFd.Show = -1 Alors
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xNomFichier = Dir(xFdItem & "*.xls*")
Faire tant que xNomFichier <> ""
Avec Workbooks.Open (xFdItem & xFileName)
' ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Insert Shift :=xlToRight
ActiveCell.Select
Terminer par
xNomFichier = Répertoire
boucle
Si fin
End Sub, aidez-moi s'il vous plaît. BTW, mon extension de fichiers Excel est (.csv - "délimité par des virgules"). et j'ai 500 fichiers Excel dans un dossier avec chaque ligne moyenne d'environ 500000 XNUMX nombre de lignes .. Aidez-moi s'il vous plaît. Je veux juste insérer une colonne dans chaque classeur
Ce commentaire a été minimisé par le modérateur sur le site
avez-vous déjà obtenu une réponse à votre question? J'essaie de faire la même chose avec plus de 3700 fichiers csv. J'ai juste besoin d'ajouter 1 colonne (A).
Ce commentaire a été minimisé par le modérateur sur le site
Salut, nécessiteux et Carly, pour résoudre votre problème, pour exécuter le code pour plusieurs fichiers CSV, il vous suffit de changer l'extension de fichier .xls en .csv comme indiqué ci-dessous : Sous LoopThroughFiles()
Boîte de dialogue Dim xFd en tant que fichier
Dim xFdItem comme variante
Estomper xFileName en tant que chaîne
Définir xFd = Application. FileDialog (msoFileDialogFolderPicker)
Si xFd.Show = -1 Alors
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xNomFichier = Dir(xFdItem & "*.csv*")
Faire tant que xNomFichier <> ""
Avec Workbooks.Open (xFdItem & xFileName)
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Insert Shift :=xlToRight
ActiveCell.Select
Terminer par
xNomFichier = Répertoire
boucle
Si fin
End SubVeuillez essayer, j'espère que cela pourra vous aider !
Ce commentaire a été minimisé par le modérateur sur le site
Salut, est-il possible d'exécuter la macro uniquement dans les feuilles de différents classeurs avec un nom spécifique ? Merci!!
Ce commentaire a été minimisé par le modérateur sur le site
Salut Sara,
Désolé, il n'y a pas de bonne solution au problème que vous avez soulevé.
Merci !
Il n'y a pas encore de commentaires postés ici
TÉLÉCHARGER PLUS
Laisser vos commentaires
Publier en tant qu'invité
×
Évaluez cet article:
0   Personnages
Emplacements suggérés

Nous suivre

Copyright © 2009 - www.extendoffice.com. | Tous les droits sont réservés. Alimenté par ExtendOffice. | | Plan du site
Microsoft et le logo Office sont des marques commerciales ou des marques déposées de Microsoft Corporation aux États-Unis et / ou dans d'autres pays.
Protégé par Sectigo SSL