如何根据Excel中的列表将文件从一个文件夹复制或移动到另一个文件夹？ 

如果在工作表的列中有一组文件名，而这些文件位于您计算机的某个文件夹中。但是现在，您需要将这些文件（其名称已列在工作表中）从原始文件夹移动或复制到另一个文件夹，如下图所示。如何在Excel中尽快完成此任务呢？

使用VBA代码根据Excel中的列表将文件从一个文件夹复制或移动到另一个文件夹

使用VBA代码根据Excel中的列表将文件从一个文件夹复制或移动到另一个文件夹

要根据文件名列表将文件从一个文件夹移动到另一个文件夹，以下VBA代码可能会对您有所帮助，请按照以下步骤操作：

1. 在Excel中按住 Alt + F11 键，打开 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

使用 Kutools AI 解锁 Excel 魔法

• 智能执行：执行单元格操作、分析数据和创建图表——所有这些都由简单命令驱动。
• 自定义公式：生成量身定制的公式，优化您的工作流程。
• VBA 编码：轻松编写和实现 VBA 代码。
• 公式解释：轻松理解复杂公式。
• 文本翻译：打破电子表格中的语言障碍。

通过人工智能驱动的工具增强您的 Excel 能力。立即下载，体验前所未有的高效！