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

Comment copier ou déplacer des fichiers d'un dossier à un autre en fonction d'une liste dans Excel? 

Si vous avez une liste de noms de fichiers dans une colonne d'une feuille de calcul et que les fichiers se trouvent dans un dossier de votre ordinateur. Mais, maintenant, vous devez déplacer ou copier ces fichiers dont les noms sont répertoriés dans la feuille de calcul de leur dossier d'origine vers un autre, comme illustré ci-dessous. Comment pourriez-vous terminer cette tâche aussi rapidement que possible dans Excel?

Copiez ou déplacez des fichiers d'un dossier à un autre en fonction d'une liste dans Excel avec le code VBA


Copiez ou déplacez des fichiers d'un dossier à un autre en fonction d'une liste dans Excel avec le code VBA

Pour déplacer les fichiers d'un dossier à un autre en fonction d'une liste de noms de fichiers, le code VBA suivant peut vous rendre service, procédez comme suit:

1. Maintenez le Alt + F11 clés dans Excel, et il ouvre le Microsoft Visual Basic pour applications fenêtre.

2Cliquez sur insérer > Moduleet collez le code VBA suivant dans la fenêtre Module.

Code VBA: déplacer des fichiers d'un dossier à un autre en fonction d'une liste dans Excel

Sub movefiles()
'Updateby Extendoffice
    Dim xRg As Range, xCell As Range
    Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xVal As String
    On Error Resume Next
    Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xSFileDlg.Title = " Please select the original folder:"
    If xSFileDlg.Show <> -1 Then Exit Sub
    xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = " Please select the destination folder:"
    If xDFileDlg.Show <> -1 Then Exit Sub
    xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
    For Each xCell In xRg
        xVal = xCell.Value
        If TypeName(xVal) = "String" And xVal <> "" Then
            FileCopy xSPathStr & xVal, xDPathStr & xVal
            Kill xSPathStr & xVal
        End If
    Next
End Sub

3. Et puis appuyez sur F5 clé pour exécuter ce code, et une boîte de dialogue apparaîtra pour vous rappeler de sélectionner les cellules qui contiennent les noms de fichiers, voir capture d'écran:

4. Puis clique OK bouton, et dans la fenêtre qui apparaît, sélectionnez le dossier contenant les fichiers que vous souhaitez déplacer, voir capture d'écran:

5. Et puis cliquez OK, continuez à sélectionner le dossier de destination où vous souhaitez localiser les fichiers dans une autre fenêtre pop-out, voir capture d'écran:

6. Enfin, cliquez OK pour fermer la fenêtre, et maintenant, les fichiers ont été déplacés dans un autre dossier que vous avez spécifié en fonction des noms de fichiers dans la liste des feuilles de calcul, voir capture d'écran:

Notes: Si vous souhaitez simplement copier les fichiers dans un autre dossier, mais conserver les fichiers d'origine, veuillez appliquer le code VBA ci-dessous:

Code VBA: copier des fichiers d'un dossier à un autre en fonction d'une liste dans Excel

Sub copyfiles()
'Updateby Extendoffice
    Dim xRg As Range, xCell As Range
    Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xVal As String
    On Error Resume Next
    Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xSFileDlg.Title = "Please select the original folder:"
    If xSFileDlg.Show <> -1 Then Exit Sub
    xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = "Please select the destination folder:"
    If xDFileDlg.Show <> -1 Then Exit Sub
    xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
    For Each xCell In xRg
        xVal = xCell.Value
        If TypeName(xVal) = "String" And xVal <> "" Then
            FileCopy xSPathStr & xVal, xDPathStr & xVal
        End If
    Next
End Sub

 


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 (69)
Pas encore de notes. Soyez le premier à évaluer!
Ce commentaire a été minimisé par le modérateur sur le site
C'est la belle macro.Real utile pour moi. mais j'ai besoin d'une macro de mise à jour utilisée pour copier les fichiers d'un dossier unique vers un autre dossier. nous avons besoin de copier les fichiers du dossier et du sous-dossier vers un autre dossier.
Ce commentaire a été minimisé par le modérateur sur le site
Salut, Dans le dossier source, je souhaite le définir comme une constante à partir d'une cellule, par exemple le chemin entré dans une cellule particulière, comme A1, doit être traité comme le dossier source. Comment faire cela ?
Ce commentaire a été minimisé par le modérateur sur le site
Era exatamente isso que eu precisava!!!

Muito Obrigado !!!!
Ce commentaire a été minimisé par le modérateur sur le site
Merci !!!!
Ce commentaire a été minimisé par le modérateur sur le site
Você não tem noção de como me ajudou com esse script... Muito bom!!! Obrigado !!!
Ce commentaire a été minimisé par le modérateur sur le site
Salut les gars,

Comment dois-je changer '' If TypeName(xVal) = "String" And xVal <> "" Then '' pour déplacer les fichiers en fonction du nom de fichier partiel.


Merci d'avance,
Cordialement, P.
Ce commentaire a été minimisé par le modérateur sur le site
Avez-vous déjà découvert COMMENT utiliser un NOM DE FICHIER PARTIEL ? J'ai besoin de ça aussi...
En d'autres termes, si le nom du fichier sur la liste des feuilles Excel est : OW4234TR_J19031.txt (j'aimerais qu'il ne regarde que les 5 derniers caractères "19031", qui est une date julienne et déplace une plage de fichiers ... tout ce qui a un Date julienne de 19031 à 19075..
Ce commentaire a été minimisé par le modérateur sur le site
J'aurais également besoin de la modification partielle du nom de fichier vba. Avez-vous déjà reçu une réponse ?
Ce commentaire a été minimisé par le modérateur sur le site
Je suis intéressé par exactement la même solution! Quelqu'un a-t-il obtenu la réponse ?J'ai une liste P/N dans une colonne, et je veux un morceau de code qui regarde dans un dossier parent qui a plusieurs sous-dossiers après les fichiers avec le nom indiqué par la liste, mais seulement partiellement, parce que je ne connais pas l'extension du fichier et dans de nombreux cas pour un seul P/N dans la liste, j'ai plusieurs fichiers différenciés par l'existence d'un suffixe qui n'a pas toujours le même schéma, comme xxxx_1, xxxx_2, xxx (1 ), xxxx [1], xxxx- (a ), xxxx_ (b) ...., mais j'ai besoin de copier dans le dossier de destination, toutes les instances des fichiers qui contiennent dans leur nom le P/N.Veuillez m'aider moi de ne pas faire ce travail manuellement pour 34078 fichiers qui se trouvent aujourd'hui dans le dossier parent et les sous-dossiers
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour,
comment faire pour que ce code copie des fichiers à partir de sous-dossiers ?
Ce commentaire a été minimisé par le modérateur sur le site
Des conseils sur la façon de modifier le code pour ajouter une carte large ? J'ai une archive de centaines de fichiers PDF qui sont des nombres à 10 chiffres et un niveau de révision (XXXXXXXXXX_REVA). Je peux très facilement exporter une liste de noms de fichiers à partir de notre système ERP, mais il manque la révision et l'extension de fichier dans la liste. Existe-t-il un moyen d'ajouter des jokers dans le programme pour ignorer tout SAUF le nombre à 10 chiffres ?
Ce commentaire a été minimisé par le modérateur sur le site
Je n'arrive pas à faire fonctionner l'une ou l'autre des versions sous Windows 10.


Argggg
Ce commentaire a été minimisé par le modérateur sur le site
en el codigo que copia ¿como puedo colorear el nombre de la lista que no encuentre?
Ce commentaire a été minimisé par le modérateur sur le site
Fonctionne très bien - merci ! Cependant-->>>Cela peut-il être ajusté pour utiliser un NOM DE FICHIER PARTIEL ? Si oui, pouvez-vous aider à montrer comment ?
En d'autres termes, si le nom de fichier sur la liste des noms de fichiers de la feuille Excel est : OW4234TR_J19031.txt (j'aimerais qu'il ne regarde que les 5 derniers caractères "19031", qui est une date julienne et déplace une plage de fichiers ... ( tout ce qui a une date julienne de 19092 à 19120) dans le dossier mars. Dossier d'avril "06-Avr" et ainsi de suite... afin que les rapprochements fiscaux par mois puissent alors avoir lieu.
Ce commentaire a été minimisé par le modérateur sur le site
salut savez-vous comment chercher aussi sur le sous-dossier ?
Ce commentaire a été minimisé par le modérateur sur le site
Quelqu'un a-t-il compris comment copier des fichiers situés dans plusieurs sous-dossiers du répertoire principal et les coller dans un autre répertoire de dossiers ? Cette méthode de transfert ne fonctionne-t-elle également que pour les dossiers du lecteur C ? J'essaie de copier des fichiers de notre répertoire qui comprend plusieurs sous-dossiers où plusieurs fichiers sont stockés situés dans Microsoft Sharepoint, vers un dossier sur mon lecteur C.

Toute aide serait très appréciée!
Ce commentaire a été minimisé par le modérateur sur le site
Merci beaucoup !
Ce commentaire a été minimisé par le modérateur sur le site
buenas noches, alguien sabe que tengo que modificar para que me mueva carpetas y no solo archivos?
Ce commentaire a été minimisé par le modérateur sur le site
Toute mise à jour de la façon de rechercher sur le dossier et les sous-dossiers
Ce commentaire a été minimisé par le modérateur sur le site
Salut Nasr,
Pour déplacer des fichiers d'un dossier et de sous-dossiers en fonction des valeurs des cellules, veuillez appliquer le code VBA ci-dessous :
S'il vous plaît essayez, j'espère que cela peut vous aider!

Sous movefiles()
'Mettre à jour par Extendoffice
Dim xRg As Range, xCell As Range
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr comme variante, xDPathStr comme variante
Dim xVal en tant que chaîne
Dim fso en tant qu'objet, dossier1 en tant qu'objet
' En cas d'erreur, reprendre le suivant
Set xRg = Application.InputBox("Veuillez sélectionner les noms de fichiers :", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
Si xRg n'est rien, quittez Sub
Définir xSFileDlg = Application. FileDialog (msoFileDialogFolderPicker)
xSFileDlg.Title = " Veuillez sélectionner le dossier d'origine :"
Si xSFileDlg.Show <> -1 Alors Quittez Sub
xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
Définir xDFileDlg = Application. FileDialog (msoFileDialogFolderPicker)
xDFileDlg.Title = " Veuillez sélectionner le dossier de destination :"
Si xDFileDlg.Show <> -1 Alors Quittez Sub
xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
Appelez sMoveFiles(xRg, xSPathStr, xDPathStr)
End Sub

Sous sMoveFiles (xRg comme plage, xSPathStr comme variante, xDPathStr comme variante)
Dim xCell As Range
Dim xVal en tant que chaîne
Estomper xFolder en tant qu'objet
Dim fso en tant qu'objet
Dim xF comme objet
Dim xStr As String
Dim xFS en tant qu'objet
Dim xI sous forme d'entier
On Error Resume Next
Si Dir(xDPathStr, vbDirectory) = "" Alors
MkDir (xDPathStr)
Si fin
Pour xI = 1 Vers xRg.Compte
Set xCell = xRg.Item(xI)
xVal = xCell.Valeur
Si TypeName(xVal) = "String" And Not (xVal = "") Alors
En cas d'erreur GoTo E1
Si Dir(xSPathStr & xVal, 16) <> Vide Alors
FichierCopier xSPathStr & xVal, xDPathStr & xVal
Tuer xSPathStr & xVal
Si fin
Si fin
E1:
Prochain xI
On Error Resume Next
Définissez fso = CreateObject ("Scripting.FileSystemObject")
Définir xFS = fso.GetFolder(xSPathStr)
Pour chaque xF dans xFS.SubFolders
xStr = xDPathStr & "\" & xF.Name ' Remplacer(xF.ShortPath, xSPathStr, xDPathStr)
Appelez sMoveFiles(xRg, xF.ShortPath & "\", xStr & "\")
Si (CreateObject("scripting.FileSystemObject").GetFolder(xStr).Files.Count = 0) _
Et (CreateObject("scripting.FileSystemObject").GetFolder(xStr).SubFolders.Count = 0) Alors
RmDir xStr
Si fin
Suivant
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
C'est parfait merci
mais qu'en est-il si je voulais juste copier des fichiers sans les déplacer des sous-dossiers uniquement sans avoir besoin de créer des sous-dossiers dans le dossier de destination
ie
dossier source X:\\parent
à l'intérieur du parent se trouvent les sous-dossiers test1 (fichier A), test2 (fichier B) et test3 (fichier C)
alors le dossier de destination est "Y:\\destination" contient les 3 fichiers A, B, C sans les sous-dossiers

Merci beaucoup
Ce commentaire a été minimisé par le modérateur sur le site
Salut Nasr, avez-vous compris comment faire cela? Je suis actuellement à la recherche d'un besoin similaire.

Copie d'une sélection de fichiers de divers sous-dossiers vers un seul dossier
Ce commentaire a été minimisé par le modérateur sur le site
Salut Mike
J'ai en quelque sorte fait MAIS indirectement, donc ce que j'ai fait est de modifier le code pour copier les fichiers et non les déplacer avec le sous-dossier
puis avec le fichier CMD déplacez le fichier des sous-dossiers vers le dossier principal puis supprimez le sous-dossier vide
c'est ce que j'ai fait

Sous-copier les fichiers()
'Mettre à jour par Extendoffice
Dim xRg As Range, xCell As Range
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr comme variante, xDPathStr comme variante
Dim xVal en tant que chaîne
Dim fso en tant qu'objet, dossier1 en tant qu'objet
' En cas d'erreur, reprendre le suivant
Set xRg = Application.InputBox("Veuillez sélectionner les noms de fichiers :", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
Si xRg n'est rien, quittez Sub
Définir xSFileDlg = Application. FileDialog (msoFileDialogFolderPicker)
xSFileDlg.Title = " Veuillez sélectionner le dossier d'origine :"
Si xSFileDlg.Show <> -1 Alors Quittez Sub
xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
Définir xDFileDlg = Application. FileDialog (msoFileDialogFolderPicker)
xDFileDlg.Title = " Veuillez sélectionner le dossier de destination :"
Si xDFileDlg.Show <> -1 Alors Quittez Sub
xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
Appelez sCopyFiles(xRg, xSPathStr, xDPathStr)
End Sub

Sous sCopyFiles (xRg comme plage, xSPathStr comme variante, xDPathStr comme variante)
Dim xCell As Range
Dim xVal en tant que chaîne
Estomper xFolder en tant qu'objet
Dim fso en tant qu'objet
Dim xF comme objet
Dim xStr As String
Dim xFS en tant qu'objet
Dim xI sous forme d'entier
On Error Resume Next
Si Dir(xDPathStr, vbDirectory) = "" Alors
MkDir (xDPathStr)
Si fin
Pour xI = 1 Vers xRg.Compte
Set xCell = xRg.Item(xI)
xVal = xCell.Valeur
Si TypeName(xVal) = "String" And Not (xVal = "") Alors
En cas d'erreur GoTo E1
Si Dir(xSPathStr & xVal, 16) <> Vide Alors
FichierCopier xSPathStr & xVal, xDPathStr & xVal
Si fin
Si fin
E1:
Prochain xI
On Error Resume Next
Définissez fso = CreateObject ("Scripting.FileSystemObject")
Définir xFS = fso.GetFolder(xSPathStr)
Pour chaque xF dans xFS.SubFolders
xStr = xDPathStr & "\" & xF.Name ' Remplacer(xF.ShortPath, xSPathStr, xDPathStr)
Appelez sCopyFiles(xRg, xF.ShortPath & "\", xStr & "\")
Si (CreateObject("scripting.FileSystemObject").GetFolder(xStr).Files.Count = 0) _
Et (CreateObject("scripting.FileSystemObject").GetFolder(xStr).SubFolders.Count = 0) Alors
RmDir xStr
Si fin
Suivant
End Sub



puis copiez les lignes suivantes dans un nouveau bloc-notes puis enregistrez-le en tant que cmd appelez-le comme bon vous semble

pour /r %%a IN (*.*) faire (
déplacer /y "%%a" "%cd%"
)
for /f "delims=" %%d in ('dir /s /b /ad ^| sort /r') do rd "%%d"



assurez-vous de copier le code tel quel 4 lignes
espérons que l'aide
Ce commentaire a été minimisé par le modérateur sur le site
assurez-vous de mettre le fichier cmd dans le même dossier que vous copiez les fichiers et sous-dossiers pour ensuite double-cliquer dessus
Ce commentaire a été minimisé par le modérateur sur le site
Vous pouvez obtenir le même résultat en utilisant uniquement le VBA si vous ajoutez un ' avant le & "\" & xF.Name dans la ligne ci-dessous.
Cela copie toujours à partir de sous-dossiers mais copie dans un dossier à un seul niveau.

xStr = xDPathStr & "\" & xF.Name ' Remplacer(xF.ShortPath, xSPathStr, xDPathStr)
Devient
xStr = xDPathStr '& "\" & xF.Name ' Remplacer(xF.ShortPath, xSPathStr, xDPathStr)
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour skyyang, je souhaite copier ou déplacer des fichiers (.jpg, .png) de n'importe quel format à partir d'un dossier et de ses sous-dossiers. Le script ci-dessus copie l'intégralité du dossier contenant le fichier correspondant
Merci et salutations,
Ce commentaire a été minimisé par le modérateur sur le site
HI, je ne suis pas un expert en VBA mais j'ai besoin de votre module et j'ai fait ce que vous avez demandé, mais rien n'a été copié du dossier source vers le nouveau dossier. et aucune erreur ne s'affiche
Ce commentaire a été minimisé par le modérateur sur le site
Et que se passe-t-il si le fichier n'existe pas dans le dossier d'origine ?
le code casse

Le code doit avoir une ligne pour passer à une autre référence si elle n'existe pas
Ce commentaire a été minimisé par le modérateur sur le site
Si la référence n'existe pas le saut de code
quelle ligne dois-je avoir au code faire un saut à travers la prochaine référence sans arrêt
Ce commentaire a été minimisé par le modérateur sur le site
Comment cela pourrait-il être adapté pour coller dans une liste de plusieurs chemins de fichiers au lieu d'un chemin à la fois ?
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Sabine,
Voulez-vous copier et coller les fichiers provenant de plusieurs dossiers d'origine au lieu d'un seul dossier ?
Ce commentaire a été minimisé par le modérateur sur le site
Oui s'il vous plaît
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