Как скопировать или переместить файлы из одной папки в другую на основе списка в Excel? 

Если у вас есть список имен файлов в столбце на листе, и эти файлы находятся в папке на вашем компьютере. Однако теперь вам нужно переместить или скопировать эти файлы, имена которых указаны на листе, из их исходной папки в другую, как показано на следующем скриншоте. Как можно выполнить эту задачу максимально быстро в Excel?

Копирование или перемещение файлов из одной папки в другую на основе списка в Excel с помощью кода VBA

Копирование или перемещение файлов из одной папки в другую на основе списка в Excel с помощью кода VBA

Чтобы переместить файлы из одной папки в другую на основе списка имен файлов, следующий код VBA может помочь вам, сделайте следующее:

1. Удерживайте клавиши Alt + F11 в Excel, это откроет окно Microsoft Visual Basic for Applications.

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. Затем нажмите кнопку ОК, и в появившемся окне выберите папку, содержащую файлы, которые вы хотите переместить, см. скриншот:

5. Затем нажмите ОК, продолжайте выбирать целевую папку, куда вы хотите переместить файлы в другом появившемся окне, см. скриншот:

6. Наконец, нажмите ОК, чтобы закрыть окно, и теперь файлы будут перемещены в другую папку, которую вы указали, на основе имен файлов в списке листов, см. скриншот:

Примечание: Если вы просто хотите скопировать файлы в другую папку, но оставить оригинальные файлы, примените следующий код 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 без особых усилий.
• Интерпретация формул: Легко разбирайтесь в сложных формулах.
• Перевод текста: Преодолейте языковые барьеры в ваших таблицах.

Улучшите возможности Excel с помощью инструментов на базе ИИ. Скачать сейчас и испытайте беспрецедентную эффективность!