Hvordan kopieres eller flyttes filer fra en mappe til en anden baseret på en liste i Excel?
Hvis du har en liste over filnavne i en kolonne i et regneark, og filerne findes i en mappe i din computer. Men nu skal du flytte eller kopiere disse filer, hvilke navne er anført i regnearket fra deres originale mappe til en anden som følgende skærmbillede vist. Hvordan kunne du afslutte denne opgave så hurtigt som muligt i Excel?
Kopier eller flyt filer fra en mappe til en anden baseret på en liste i Excel med VBA-kode
Kopier eller flyt filer fra en mappe til en anden baseret på en liste i Excel med VBA-kode
For at flytte filerne fra en mappe til en anden baseret på en liste med filnavne, kan følgende VBA-kode muligvis gøre dig en tjeneste, gør som dette:
1. Hold nede Alt + F11 nøgler i Excel, og det åbner Microsoft Visual Basic til applikationer vindue.
2. Klik indsatte > Moduler, og indsæt følgende VBA-kode i modulvinduet.
VBA-kode: Flyt filer fra en mappe til en anden baseret på en liste i 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. Og tryk derefter på F5 nøgle til at køre denne kode, og der vises et promptfelt for at minde dig om at vælge de celler, der indeholder filnavne, se skærmbillede:
4. Klik derefter på OK knappen, og i det poppede ud-vindue skal du vælge den mappe, der indeholder de filer, du vil flytte fra, se skærmbillede:
5. Og klik derefter på OK, fortsæt med at vælge destinationsmappen, hvor du vil finde filerne i et andet poppet ud-vindue, se skærmbillede:
6. Endelig skal du klikke på OK for at lukke vinduet, og nu er filerne flyttet til en anden mappe, du har angivet baseret på filnavne i regnearklisten, se skærmbillede:
Bemærk: Hvis du bare vil kopiere filerne til en anden mappe, men beholde de originale filer, skal du anvende nedenstående VBA-kode:
VBA-kode: Kopier filer fra en mappe til en anden baseret på en liste i 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
Bedste kontorproduktivitetsværktøjer
Overlad dine Excel-færdigheder med Kutools til Excel, og oplev effektivitet som aldrig før. Kutools til Excel tilbyder over 300 avancerede funktioner for at øge produktiviteten og spare tid. Klik her for at få den funktion, du har mest brug for...
Fanen Office bringer en grænseflade til et kontor med Office, og gør dit arbejde meget lettere
- Aktiver redigering og læsning af faner i Word, Excel, PowerPoint, Publisher, Access, Visio og Project.
- Åbn og opret flere dokumenter i nye faner i det samme vindue snarere end i nye vinduer.
- Øger din produktivitet med 50 % og reducerer hundredvis af museklik for dig hver dag!