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