¿Cómo copiar o mover archivos de una carpeta a otra basándose en una lista en Excel? 

Si tienes una lista de nombres de archivos en una columna de una hoja de cálculo, y los archivos están ubicados en una carpeta en tu computadora. Pero ahora, necesitas mover o copiar estos archivos, cuyos nombres están listados en la hoja de cálculo, desde su carpeta original a otra, como se muestra en la siguiente captura de pantalla. ¿Cómo podrías completar esta tarea lo más rápido posible en Excel?

Copiar o mover archivos de una carpeta a otra basándose en una lista en Excel con código VBA

Copiar o mover archivos de una carpeta a otra basándose en una lista en Excel con código VBA

Para mover archivos de una carpeta a otra basándose en una lista de nombres de archivos, el siguiente código VBA puede ayudarte, por favor sigue estos pasos:

1. Mantén presionadas las teclas Alt + F11 en Excel, y esto abrirá la ventana de Microsoft Visual Basic para Aplicaciones.

2. Haz clic en Insertar > Módulo, y pega el siguiente código VBA en la Ventana del Módulo.

Código VBA: Mover archivos de una carpeta a otra basándose en una lista en 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. Luego presiona la tecla F5 para ejecutar este código, y aparecerá un cuadro de diálogo que te recordará seleccionar las celdas que contienen los nombres de los archivos, ver captura de pantalla:

4. Luego haz clic en el botón Aceptar, y en la ventana emergente, selecciona la carpeta que contiene los archivos que deseas mover, ver captura de pantalla:

5. Luego haz clic en Aceptar, continúa seleccionando la carpeta de destino donde deseas colocar los archivos en otra ventana emergente, ver captura de pantalla:

6. Finalmente, haz clic en Aceptar para cerrar la ventana, y ahora, los archivos se han movido a otra carpeta que especificaste basándote en los nombres de archivo en la lista de la hoja de cálculo, ver captura de pantalla:

Nota: Si solo quieres copiar los archivos a otra carpeta pero mantener los archivos originales, aplica el siguiente código VBA:

Código VBA: Copiar archivos de una carpeta a otra basándose en una lista en 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

Descubre la Magia de Excel con Kutools AI

• Ejecución Inteligente: Realiza operaciones en celdas, analiza datos y crea gráficos, todo impulsado por comandos simples.
• Fórmulas Personalizadas: Genera fórmulas adaptadas para optimizar tus flujos de trabajo.
• Codificación VBA: Escribe e implementa código VBA sin esfuerzo.
• Interpretación de Fórmulas: Comprende fórmulas complejas con facilidad.
• Traducción de Texto: Supera las barreras del idioma dentro de tus hojas de cálculo.

Potencia tus capacidades de Excel con herramientas impulsadas por IA. ¡Descarga Ahora y experimenta una eficiencia como nunca antes!