Hoe kopieer of verplaats je bestanden van de ene map naar de andere op basis van een lijst in Excel? 

Als je een lijst met bestandsnamen hebt in een kolom in een werkblad, en de bestanden bevinden zich in een map op je computer. Maar nu moet je deze bestanden, waarvan de namen in het werkblad staan, verplaatsen of kopiëren van hun oorspronkelijke map naar een andere, zoals te zien is in de volgende schermafbeelding. Hoe kun je deze taak zo snel mogelijk afhandelen in Excel?

Kopieer of verplaats bestanden van de ene map naar de andere op basis van een lijst in Excel met VBA-code

Kopieer of verplaats bestanden van de ene map naar de andere op basis van een lijst in Excel met VBA-code

Om bestanden van de ene map naar de andere te verplaatsen op basis van een lijst met bestandsnamen, kan de volgende VBA-code je helpen. Doe het volgende:

1. Druk in Excel tegelijkertijd op de toetsen Alt + F11 om het venster Microsoft Visual Basic for Applications te openen.

2. Klik op Invoegen > Module en plak de volgende VBA-code in het modulevenster.

VBA-code: Verplaats bestanden van de ene map naar de andere op basis van een lijst in 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. Druk vervolgens op de F5-toets om deze code uit te voeren, en er verschijnt een pop-upvenster dat je eraan herinnert de cellen te selecteren die de bestandsnamen bevatten, zie onderstaande schermafbeelding:

4. Klik vervolgens op de knop OK, en in het pop-upvenster selecteer je de map die de bestanden bevat die je wilt verplaatsen, zie onderstaande schermafbeelding:

5. Klik vervolgens op OK en ga door met het selecteren van de doelmap waar je de bestanden wilt plaatsen in een ander pop-upvenster, zie onderstaande schermafbeelding:

6. Klik ten slotte op OK om het venster te sluiten, en nu zijn de bestanden verplaatst naar de andere map die je hebt gespecificeerd op basis van de bestandsnamen in de werkbladlijst, zie onderstaande schermafbeelding:

Opmerking: Als je de bestanden alleen wilt kopiëren naar een andere map maar de originele bestanden wilt behouden, gebruik dan de volgende VBA-code:

VBA-code: Kopieer bestanden van de ene map naar de andere op basis van een lijst in 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

Ontdek de Magie van Excel met Kutools AI

• Slimme Uitvoering: Voer celbewerkingen uit, analyseer gegevens en maak diagrammen – allemaal aangestuurd door eenvoudige commando's.
• Aangepaste Formules: Genereer op maat gemaakte formules om uw workflows te versnellen.
• VBA-codering: Schrijf en implementeer VBA-code moeiteloos.
• Formule-uitleg: Begrijp complexe formules gemakkelijk.
• Tekstvertaling: Overbrug taalbarrières binnen uw spreadsheets.

Verhoog uw Excel-mogelijkheden met AI-aangedreven tools. Download Nu en ervaar een ongekende efficiëntie!