Hoe kopieert of verplaatst u bestanden van de ene map naar de andere op basis van een lijst in Excel?
Als u een lijst met bestandsnamen hebt in een kolom van een werkblad en de bijbehorende bestanden zich in een map op uw computer bevinden, hoe kunt u deze bestanden — waarvan de namen in het werkblad staan vermeld — dan zo snel mogelijk verplaatsen of kopiëren van hun oorspronkelijke map naar een andere map, zoals in de onderstaande schermafbeelding is weergegeven?
Bestanden kopiëren of verplaatsen van de ene map naar de andere op basis van een lijst in Excel met VBA-code
Om bestanden te verplaatsen van de ene map naar de andere op basis van een lijst met bestandsnamen, helpt de volgende VBA-code u daarbij. Volg deze stappen:
1. Houd in Excel de toetsen Alt + F11 ingedrukt. Het venster Microsoft Visual Basic for Applications opent zich hierdoor.
2. Klik op Invoegen > Module en plak de volgende VBA-code in het modulevenster.
VBA-code: Bestanden verplaatsen 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 toets F5 om deze code uit te voeren. Er verschijnt een dialoogvenster waarin u wordt gevraagd de cellen met de bestandsnamen te selecteren; zie schermafbeelding:
4. Klik daarna op de knop OK. Selecteer in het geopende venster de map die de bestanden bevat die u wilt verplaatsen; zie schermafbeelding:
5. Klik vervolgens op OK en selecteer in het volgende venster de doelmap waarin u de bestanden wilt plaatsen; zie schermafbeelding:
6. Klik tot slot op OK om dit venster te sluiten. De bestanden zijn nu verplaatst naar de door u opgegeven map op basis van de bestandsnamen in Werkbladlijst; zie schermafbeelding:
Opmerking: Als u de bestanden alleen naar een andere map wilt kopiëren en de originele bestanden wilt behouden, gebruik dan de onderstaande VBA-code:
VBA-code: Bestanden kopiëren 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
Ontgrendel de magie van Excel met KUTOOLS AI
- Slimme uitvoering: Voer celbewerkingen uit, analyseer gegevens en maak grafieken — allemaal met eenvoudige opdrachten.
- aangepaste formules: Genereer op maat gemaakte formules om uw workflows te stroomlijnen.
- VBA-programmeren: Schrijf en implementeer VBA-code moeiteloos.
- Formule-uitleg: Begrijp complexe formules moeiteloos.
- Tekstvertaling: Doorbreek taalbarrières in uw spreadsheets.
Beste Office-productiviteitshulpmiddelen
Geef uw Excel-vaardigheden een boost met Kutools voor Excel en ervaar efficiëntie zoals nooit tevoren.Kutools voor Excel biedt meer dan 300 geavanceerde functies om de productiviteit te verhogen en Tijd besparen.Klik hier om de functie te krijgen die u het meest nodig heeft...
Office Tab brengt een tabbladinterface naar Office en maakt uw werk veel eenvoudiger
- Schakel tabbladbewerking en -lezen in voor Word, Excel, PowerPoint, Publisher, Access, Visio en Project.
- Open en maak meerdere documenten aan in nieuwe tabbladen binnen hetzelfde venster, in plaats van in afzonderlijke vensters.
- Verhoogt uw productiviteit met 50 % en bespaart u dagelijks honderden muisklikken!
Alle Kutools-add-ins in één installatieprogramma.
Kutools for Office bundelt add-ins voor Excel, Word, Outlook en PowerPoint, plus Office Tab Pro—ideaal voor teams die met meerdere Office-apps werken.
- Alles-in-één suite— add-ins voor Excel, Word, Outlook & PowerPoint plus Office Tab Pro
- Één installatieprogramma, één licentie— binnen enkele minuten klaar (MSI-geschikt)
- Werkt beter samen— gestroomlijnde productiviteit in alle Office-apps
- 30 dagen volledig functionele proefversie— geen registratie, geen creditcard
- Beste prijs-kwaliteitverhouding— bespaar ten opzichte van het afzonderlijk kopen van add-ins