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
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.
Beste productiviteitstools voor Office
Verbeter je Excel-vaardigheden met Kutools voor Excel en ervaar ongeëvenaarde efficiëntie. Kutools voor Excel biedt meer dan300 geavanceerde functies om je productiviteit te verhogen en tijd te besparen. Klik hier om de functie te kiezen die je het meest nodig hebt...
Office Tab brengt een tabbladinterface naar Office en maakt je werk veel eenvoudiger
- Activeer tabbladbewerking en -lezen in Word, Excel, PowerPoint, Publisher, Access, Visio en Project.
- Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster, in plaats van in nieuwe vensters.
- Verhoog je productiviteit met50% en bespaar dagelijks honderden muisklikken!
Alle Kutools-invoegtoepassingen. Eén installatieprogramma
Kutools for Office-suite bundelt invoegtoepassingen voor Excel, Word, Outlook & PowerPoint plus Office Tab Pro, ideaal voor teams die werken met Office-toepassingen.
- Alles-in-één suite — invoegtoepassingen voor Excel, Word, Outlook & PowerPoint + Office Tab Pro
- Eén installatieprogramma, één licentie — in enkele minuten geïnstalleerd (MSI-ready)
- Werkt beter samen — gestroomlijnde productiviteit over meerdere Office-toepassingen
- 30 dagen volledige proef — geen registratie, geen creditcard nodig
- Beste prijs — bespaar ten opzichte van losse aanschaf van invoegtoepassingen