Como copiar ou mover arquivos de uma pasta para outra com base em uma lista no Excel? 

Se você tiver uma lista de nomes de arquivo em uma coluna em uma planilha, e os arquivos forem localizados em uma pasta em seu computador. Mas, agora, você precisa mover ou copiar esses arquivos cujos nomes estão listados na planilha de sua pasta original para outra como mostrado a seguir. Como você poderia terminar essa tarefa o mais rápido possível no Excel?

Copie ou mova arquivos de uma pasta para outra com base em uma lista no Excel com código VBA

Copie ou mova arquivos de uma pasta para outra com base em uma lista no Excel com código VBA

Para mover os arquivos de uma pasta para outra com base em uma lista de nomes de arquivos, o seguinte código VBA pode lhe fazer um favor, faça o seguinte:

1. Segure o Alt + F11 chaves no Excel, e abre o Microsoft Visual Basic para Aplicações janela.

2. Clique inserção > Móduloe cole o seguinte código VBA na janela do módulo.

Código VBA: mover arquivos de uma pasta para outra com base em uma lista no 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. E, em seguida, pressione F5 para executar este código e uma caixa de prompt aparecerá para lembrá-lo de selecionar as células que contêm os nomes dos arquivos, veja a captura de tela:

4. Então clique OK botão e na janela aberta, selecione a pasta que contém os arquivos dos quais você deseja mover, veja a captura de tela:

5. E, em seguida, clique em OK, continue selecionando a pasta de destino onde deseja localizar os arquivos em outra janela aberta, veja a captura de tela:

6. Finalmente, clique em OK para fechar a janela, e agora, os arquivos foram movidos para outra pasta que você especificou com base nos nomes dos arquivos na lista de planilhas, veja a captura de tela:

Note: Se você deseja apenas copiar os arquivos para outra pasta, mas manter os arquivos originais, aplique o código VBA abaixo:

Código VBA: copie arquivos de uma pasta para outra com base em uma lista no 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