Как копировать или перемещать файлы из одной папки в другую на основе списка в Excel?
Если у вас есть список имён файлов в столбце листа, а сами файлы находятся в папке на вашем компьютере, но теперь вам нужно переместить или скопировать эти файлы — чьи имена указаны в таблице — из исходной папки в другую, как показано на следующем снимке экрана. Как можно быстрее выполнить эту задачу в Excel?
Копирование или перемещение файлов из одной папки в другую на основе списка в Excel с помощью кода VBA
Чтобы переместить файлы из одной папки в другую на основе списка имён файлов, воспользуйтесь приведённым ниже кодом VBA. Выполните следующие действия:
1. Удерживая клавиши Alt + F11, откройте окно 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 AI
- Интеллектуальное выполнение: Выполняйте операции с ячейками, анализируйте данные и создавайте диаграммы — всё это доступно через простые команды.
- Пользовательские формулы: создавайте индивидуальные формулы для оптимизации рабочих процессов.
- Программирование на VBA: Пишите и внедряйте код VBA легко и без усилий.
- Анализ формул: Легко разбирайтесь даже в самых сложных формулах.
- Перевод текста: Ломайте языковые барьеры прямо в ваших таблицах.
Лучшие инструменты повышения продуктивности в Office
Раскройте весь потенциал Excel с помощью Kutools для Excel и ощутите эффективность как никогда раньше.Kutools для Excel предлагает более 300 расширенных функций для повышения продуктивности и Экономия времени.Нажмите здесь, чтобы получить нужную Вам функцию…
Office Tab добавляет в Office вкладки и значительно упрощает Вашу работу
- Включите редактирование и чтение во вкладках в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
- Открывайте и создавайте несколько документов во вкладках одного окна — вместо того чтобы использовать отдельные окна.
- Повышает вашу продуктивность на 50 % и экономит сотни кликов мышью каждый день!
Все надстройки Kutools — один установщик
Kutools for Office — набор надстроек для Excel, Word, Outlook и PowerPoint, а также Office Tab Pro, идеально подходящий командам, работающим с разными приложениями Office.
- Единый комплект— надстройки для Excel, Word, Outlook и PowerPoint + Office Tab Pro
- Один установщик, одна лицензия— настройка занимает считанные минуты (готово для MSI)
- Лучше работать вместе— оптимизированная продуктивность во всех приложениях Office
- 30-дневная полнофункциональная пробная версия— без регистрации и кредитной карты
- Лучшее соотношение цены и качества— экономия по сравнению с покупкой отдельных надстроек