Как скопировать или переместить файлы из одной папки в другую на основе списка в Excel?
Если у вас есть список имен файлов в столбце на листе, и файлы находятся в папке на вашем компьютере. Но теперь вам нужно переместить или скопировать эти файлы, имена которых указаны на листе, из их исходной папки в другую, как показано на следующем снимке экрана. Как вы могли выполнить эту задачу так быстро, как вы можете в Excel?
Копируйте или перемещайте файлы из одной папки в другую на основе списка в Excel с кодом VBA
Копируйте или перемещайте файлы из одной папки в другую на основе списка в Excel с кодом VBA
Чтобы переместить файлы из одной папки в другую на основе списка имен файлов, следующий код VBA может оказать вам услугу, пожалуйста, сделайте следующее:
1. Удерживайте Alt + F11 ключи в Excel, и он открывает Microsoft Visual Basic для приложений окно.
2. Нажмите Вставить > Модулии вставьте следующий код VBA в окно модуля.
Код VBA: перемещать файлы из одной папки в другую на основе списка в 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, Затем нажмите F5 нажмите клавишу для запуска этого кода, и появится диалоговое окно с напоминанием о выборе ячеек, содержащих имена файлов, см. снимок экрана:
4. Затем нажмите OK и в появившемся окне выберите папку, содержащую файлы, из которых вы хотите переместиться, см. снимок экрана:
5, Затем нажмите OK, продолжайте выбирать папку назначения, в которой вы хотите найти файлы, в другом всплывающем окне, см. снимок экрана:
6, Наконец, нажмите OK чтобы закрыть окно, и теперь файлы были перемещены в другую папку, которую вы указали на основе имен файлов в списке листов, см. снимок экрана:
Внимание: Если вы просто хотите скопировать файлы в другую папку, но сохранить исходные файлы, примените приведенный ниже код VBA:
Код VBA: копирование файлов из одной папки в другую на основе списка в 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
Лучшие инструменты для офисной работы
Улучшите свои навыки работы с Excel с помощью Kutools for Excel и почувствуйте эффективность, как никогда раньше. Kutools for Excel предлагает более 300 расширенных функций для повышения производительности и экономии времени. Нажмите здесь, чтобы получить функцию, которая вам нужна больше всего...
Вкладка Office: интерфейс с вкладками в Office и упрощение работы
- Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
- Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
- Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!