Hogyan lehet fájlokat másolni vagy áthelyezni egyik mappából egy másikba az Excel listája alapján?
Ha a munkalap oszlopában van egy fájlnévlista, és a fájlok a compulator mappájában találhatók. Most azonban áthelyeznie vagy át kell másolnia ezeket a fájlokat, amelyek a munkalapon fel vannak tüntetve, az eredeti mappájukból egy másikba, az alábbi képernyőkép szerint. Hogyan tudná ezt a feladatot a lehető leggyorsabban elvégezni az Excelben?
Másolja vagy helyezze át a fájlokat egyik mappából a másikba az Excel VBA kóddal ellátott listája alapján
A fájlok egyik mappából a másikba történő áthelyezéséhez a fájlnevek listája alapján a következő VBA-kód kedvezhet, kérjük, tegye a következőket:
1. Tartsa lenyomva a Alt + F11 kulcsokat az Excelben, és megnyitja a Microsoft Visual Basic for Applications ablak.
2. Kattints betétlap > Modulok, és illessze be a következő VBA kódot a Modul ablakba.
VBA kód: Fájlok áthelyezése egyik mappából a másikba az Excel listája alapján
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. Ezután nyomja meg a gombot F5 kulcs a kód futtatásához, és megjelenik egy prompt doboz, amely emlékezteti Önt a fájlneveket tartalmazó cellák kiválasztására, lásd a képernyőképet:
4. Ezután kattintson OK gombra, és a felbukkanó ablakban válassza ki a mappát, amely tartalmazza az áthelyezni kívánt fájlokat, lásd a képernyőképet:
5. Kattintson a gombra OK, folytassa a célmappát, ahol a fájlokat egy másik felbukkanó ablakban szeretné megtalálni, lásd a képernyőképet:
6. Végül kattintson a gombra OK az ablak bezárásához, és most a fájlokat áthelyezték egy másik mappába, amelyet a munkalap-lista fájlnevei alapján megadott, lásd a képernyőképet:
Megjegyzések: Ha csak egy másik mappába akarja másolni a fájlokat, de megtartja az eredeti fájlokat, kérjük, alkalmazza az alábbi VBA kódot:
VBA kód: Fájlok másolása egyik mappából a másikba az Excel listája alapján
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
A legjobb irodai hatékonyságnövelő eszközök
Töltsd fel Excel-készségeidet a Kutools for Excel segítségével, és tapasztald meg a még soha nem látott hatékonyságot. A Kutools for Excel több mint 300 speciális funkciót kínál a termelékenység fokozásához és az időmegtakarításhoz. Kattintson ide, hogy megszerezze a leginkább szükséges funkciót...
Az Office lap füles felületet hoz az Office-ba, és sokkal könnyebbé teszi a munkáját
- Füles szerkesztés és olvasás engedélyezése Wordben, Excelben és PowerPointban, Publisher, Access, Visio és Project.
- Több dokumentum megnyitása és létrehozása ugyanazon ablak új lapjain, mint új ablakokban.
- 50% -kal növeli a termelékenységet, és naponta több száz kattintással csökkenti az egér kattintását!