Note: The other languages of the website are Google-translated. Back to English

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:

Nota: 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

 


As melhores ferramentas de produtividade para escritório

O Kutools for Excel resolve a maioria dos seus problemas e aumenta sua produtividade em 80%

  • armadilha para peixes: Insira rapidamente fórmulas complexas, gráficos e qualquer coisa que você tenha usado antes; Criptografar células com senha; Criar lista de discussão e enviar emails ...
  • Barra Super Fórmula (edite facilmente várias linhas de texto e fórmula); Layout de leitura (ler e editar facilmente um grande número de células); Colar na faixa filtrada...
  • Mesclar células / linhas / colunas sem perder dados; Dividir o conteúdo das células; Combinar linhas / colunas duplicadas... Evite células duplicadas; Comparar intervalos...
  • Selecione Duplicado ou Único Linhas; Selecione linhas em branco (todas as células estão vazias); Super Find e Fuzzy Find em muitos livros; Seleção aleatória ...
  • Cópia exata Várias células sem alterar a referência da fórmula; Criação automática de referências para várias folhas; Inserir marcadores, Caixas de seleção e mais ...
  • Extrair Texto, Adicionar texto, remover por posição, Remover Espaço; Criar e imprimir subtotais de paginação; Converter entre conteúdo de células e comentários...
  • Super Filtro (salvar e aplicar esquemas de filtro a outras planilhas); Classificação Avançada por mês / semana / dia, frequência e mais; Filtro Especial por negrito, itálico ...
  • Combine pastas de trabalho e planilhas; Mesclar tabelas com base em colunas-chave; Divida os dados em várias folhas; Conversão em lote de xls, xlsx e PDF...
  • Mais de 300 recursos poderosos. Suporta Office / Excel 2007-2019 e 365. Suporta todos os idiomas. Fácil implantação em sua empresa ou organização. Teste gratuito de 30 dias com recursos completos. Garantia de devolução do dinheiro em 60 dias.
guia kte 201905

Guia do Office traz interface com guias para o Office e torna seu trabalho muito mais fácil

  • Habilite a edição e leitura com guias em Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
  • Abra e crie vários documentos em novas guias da mesma janela, em vez de em novas janelas.
  • Aumenta sua produtividade em 50% e reduz centenas de cliques do mouse para você todos os dias!
parte inferior da aba do escritório

 

Comentários (60)
Ainda não há classificações. Seja o primeiro a avaliar!
Este comentário foi feito pelo moderador no site
É o bom macro.Real útil para mim. mas eu preciso de alguma atualização macro.this usado para copiar os arquivos de uma única pasta para outra pasta. precisamos copiar arquivos da pasta e subpasta para outra pasta.
Este comentário foi feito pelo moderador no site
Oi, Na pasta de origem, desejo defini-la como constante de uma célula, por exemplo, o caminho inserido em uma determinada célula, como A1, deve ser tratado como a pasta de origem. Como fazer isso?
Este comentário foi feito pelo moderador no site
Era exatamente isso que eu queria!!!

Muito Obrigado!!!!
Este comentário foi feito pelo moderador no site
Obrigado !!!!
Este comentário foi feito pelo moderador no site
Você não tem noção de como me oferece com script... Muito bom!!! Obrigado!!!
Este comentário foi feito pelo moderador no site
Oi Pessoal,

Como eu preciso mudar '' If TypeName(xVal) = "String" And xVal <> "" Then '' para mover arquivos com base no nome do arquivo parcial.


Agradecemos antecipadamente,
Atenciosamente, P.
Este comentário foi feito pelo moderador no site
Você já descobriu COMO usar um NOME DE ARQUIVO PARCIAL? Eu preciso disso também...
Em outras palavras, se o nome do arquivo na lista de planilhas do Excel for: OW4234TR_J19031.txt (eu gostaria que ele olhasse apenas os últimos 5 caracteres "19031" que é uma Data Juliana e mova um intervalo de arquivos... qualquer coisa com um Data Juliana de 19031 a 19075..
Este comentário foi feito pelo moderador no site
Eu também exigiria a modificação parcial do nome do arquivo vba. Alguma vez você obteve uma resposta?
Este comentário foi feito pelo moderador no site
Estou interessado exatamente na mesma solução! Alguém obteve a resposta? Tenho uma lista de P/N em uma coluna, e quero um pedaço de código que procure em uma pasta pai que tenha várias subpastas depois de arquivos com o nome indicado pela lista, mas apenas parcialmente, pois não sei a extensão do arquivo e em muitos casos para um único P/N na lista, tenho vários arquivos diferenciados pela existência de um sufixo que nem sempre tem o mesmo padrão, como xxxx_1, xxxx_2, xxx (1 ), xxxx [1], xxxx- (a ), xxxx_ (b) ...., mas preciso copiar na pasta de destino, todas as instâncias dos arquivos que contenham em seu nome o P/N. me para não fazer este trabalho manualmente para 34078 arquivos que hoje encontra na pasta pai e subpastas
Este comentário foi feito pelo moderador no site
Olá,
como fazer este código copiar arquivos de subpastas?
Este comentário foi feito pelo moderador no site
Alguma dica sobre como modificar o código para adicionar um cartão largo? Eu tenho um arquivo de centenas de arquivos PDF que são números de 10 dígitos e nível de revisão (XXXXXXXXXX_REVA). Posso exportar uma lista de nomes de arquivos com muita facilidade do nosso sistema ERP, mas a lista não contém a revisão e a extensão do arquivo. Existe uma maneira de adicionar curingas no programa para ignorar tudo, exceto o número de 10 dígitos?
Este comentário foi feito pelo moderador no site
Não consigo fazer com que nenhuma das versões funcione no Windows 10.


Arggg
Este comentário foi feito pelo moderador no site
en el codigo que copia ¿como puedo colorear el nombre da lista que no encuentre?
Este comentário foi feito pelo moderador no site
Funciona muito bem - obrigado! No entanto-->>>Isso pode ser ajustado para usar um NOME DE ARQUIVO PARCIAL? Se sim, você pode ajudar a mostrar como?
Em outras palavras, se o nome do arquivo na lista de nomes de arquivos da planilha do Excel for: OW4234TR_J19031.txt (eu gostaria que ele olhasse apenas os últimos 5 caracteres "19031", que é uma Data Juliana e mova um intervalo de arquivos ... ( qualquer coisa com uma data juliana de 19092 a 19120) na pasta março. Pasta de abril "06-Abr" e assim por diante... para que as reconciliações fiscais por mês possam ocorrer.
Este comentário foi feito pelo moderador no site
oi você sabe como pesquisar também na subpasta?
Este comentário foi feito pelo moderador no site
Alguém descobriu como copiar arquivos localizados em várias subpastas do diretório principal e colar em outro diretório de pastas? Além disso, esse método de transferência só funciona para pastas na unidade C? Estou tentando copiar arquivos do nosso diretório que inclui várias subpastas onde vários arquivos estão armazenados localizados no Microsoft Sharepoint, para uma pasta na minha unidade C.

Qualquer ajuda seria muito apreciada!
Este comentário foi feito pelo moderador no site
Muito obrigado !
Este comentário foi feito pelo moderador no site
buenas noches, alguien sabe que tengo que modificar para que me mueva carpetas y no solo archivos?
Este comentário foi feito pelo moderador no site
Qualquer atualização de como pesquisar na pasta e subpastas
Este comentário foi feito pelo moderador no site
Olá, Nasr,
Para mover arquivos da pasta e subpastas com base nos valores das células, aplique o código VBA abaixo:
Por favor, tente, espero que possa ajudá-lo!

Submovefiles()
'Atualizar por Extendoffice
Dim xRg como intervalo, xCell como intervalo
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr como variante, xDPathStr como variante
Dim xVal como string
Dim fso como objeto, pasta1 como objeto
' Em Erro Continuar Próximo
Set xRg = Application.InputBox("Por favor, selecione os nomes dos arquivos:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
Se xRg não for nada, saia do sub
Definir xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xSFileDlg.Title = " Por favor, selecione a pasta original:"
Se xSFileDlg.Show <> -1 Então Exit Sub
xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
Definir xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xDFileDlg.Title = " Por favor, selecione a pasta de destino:"
If xDFileDlg.Show <> -1 Then Exit Sub
xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
Chame sMoveFiles(xRg, xSPathStr, xDPathStr)
End Sub

Sub sMoveFiles(xRg como intervalo, xSPathStr como variante, xDPathStr como variante)
Dim xCell como intervalo
Dim xVal como string
Dim xFolder As Object
Dim fso como objeto
Dim xF como objeto
Dim xStr As String
Dim xFS como objeto
Dim xI como inteiro
On Error Resume Next
If Dir(xDPathStr, vbDirectory) = "" Então
MkDir (xDPathStr)
Se acabar
Para xI = 1 Para xRg.Count
Definir xCell = xRg.Item(xI)
xVal = xCell.Value
Se TypeName(xVal) = "String" e não (xVal = "") Então
Em erro GoTo E1
If Dir(xSPathStr & xVal, 16) <> Vazio Então
FileCopy xSPathStr & xVal, xDPathStr & xVal
Matar xSPathStr & xVal
Se acabar
Se acabar
E1:
Próximo xI
On Error Resume Next
Defina fso = CreateObject ("Scripting.FileSystemObject")
Definir xFS = fso.GetFolder(xSPathStr)
Para cada xF em xFS.SubFolders
xStr = xDPathStr & "\" & xF.Name ' Replace(xF.ShortPath, xSPathStr, xDPathStr)
Chame sMoveFiles(xRg, xF.ShortPath & "\", xStr & "\")
If (CreateObject("script.FileSystemObject").GetFolder(xStr).Files.Count = 0) _
E (CreateObject("scripting.FileSystemObject").GetFolder(xStr).SubFolders.Count = 0) Então
RmDir xStr
Se acabar
Seguinte
End Sub
Este comentário foi feito pelo moderador no site
Está perfeito obrigado
mas e se eu só quisesse copiar arquivos não movendo-os de subpastas apenas sem a necessidade de criar subpastas na pasta de destino
ie
pasta de origem X:\\parent
dentro do pai estão as subpastas test1 (arquivo A), test2 (arquivo B) e test3 (arquivo C)
então a pasta de destino é "Y:\\destination" tem todos os 3 arquivos A, B, C sem as subpastas

Muito obrigado
Este comentário foi feito pelo moderador no site
Oi Nasr, você descobriu como fazer isso? Estou olhando para uma necessidade semelhante no momento.

Copiando uma seleção de arquivos de várias subpastas para uma única pasta
Este comentário foi feito pelo moderador no site
Olá Mike
Eu meio que fiz MAS indiretamente, então o que fiz foi modificar o código para copiar os arquivos e não movê-los com a subpasta
em seguida, com o arquivo CMD, mova o arquivo das subpastas para a pasta principal e exclua a subpasta vazia
isso é o que eu fiz

Sub Copyfiles()
'Atualizar por Extendoffice
Dim xRg como intervalo, xCell como intervalo
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr como variante, xDPathStr como variante
Dim xVal como string
Dim fso como objeto, pasta1 como objeto
' Em Erro Continuar Próximo
Set xRg = Application.InputBox("Por favor, selecione os nomes dos arquivos:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
Se xRg não for nada, saia do sub
Definir xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xSFileDlg.Title = " Por favor, selecione a pasta original:"
Se xSFileDlg.Show <> -1 Então Exit Sub
xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
Definir xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xDFileDlg.Title = " Por favor, selecione a pasta de destino:"
If xDFileDlg.Show <> -1 Then Exit Sub
xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
Chame sCopyFiles(xRg, xSPathStr, xDPathStr)
End Sub

Sub sCopyFiles(xRg como intervalo, xSPathStr como variante, xDPathStr como variante)
Dim xCell como intervalo
Dim xVal como string
Dim xFolder As Object
Dim fso como objeto
Dim xF como objeto
Dim xStr As String
Dim xFS como objeto
Dim xI como inteiro
On Error Resume Next
If Dir(xDPathStr, vbDirectory) = "" Então
MkDir (xDPathStr)
Se acabar
Para xI = 1 Para xRg.Count
Definir xCell = xRg.Item(xI)
xVal = xCell.Value
Se TypeName(xVal) = "String" e não (xVal = "") Então
Em erro GoTo E1
If Dir(xSPathStr & xVal, 16) <> Vazio Então
FileCopy xSPathStr & xVal, xDPathStr & xVal
Se acabar
Se acabar
E1:
Próximo xI
On Error Resume Next
Defina fso = CreateObject ("Scripting.FileSystemObject")
Definir xFS = fso.GetFolder(xSPathStr)
Para cada xF em xFS.SubFolders
xStr = xDPathStr & "\" & xF.Name ' Replace(xF.ShortPath, xSPathStr, xDPathStr)
Chame sCopyFiles(xRg, xF.ShortPath & "\", xStr & "\")
If (CreateObject("script.FileSystemObject").GetFolder(xStr).Files.Count = 0) _
E (CreateObject("scripting.FileSystemObject").GetFolder(xStr).SubFolders.Count = 0) Então
RmDir xStr
Se acabar
Seguinte
End Sub



em seguida, copie as seguintes linhas para um novo bloco de notas e salve-o como cmd, chame-o de qualquer maneira

para /r %%a IN (*.*) faça (
mover /y "%%a" "%cd%"
)
for /f "delims=" %%d in ('dir /s /b /ad ^| sort /r') do rd "%%d"



certifique-se de copiar o código como é de 4 linhas
espero que ajude
Este comentário foi feito pelo moderador no site
certifique-se de colocar o arquivo cmd na mesma pasta que você copia os arquivos e subpastas para, em seguida, clicar duas vezes nele
Este comentário foi feito pelo moderador no site
Você pode obter o mesmo resultado usando apenas o VBA se adicionar um ' antes de & "\" & xF.Name na linha abaixo.
Isso ainda copia de subpastas, mas copia para uma pasta de nível único.

xStr = xDPathStr & "\" & xF.Name ' Replace(xF.ShortPath, xSPathStr, xDPathStr)
Torna-se
xStr = xDPathStr '& "\" & xF.Name ' Replace(xF.ShortPath, xSPathStr, xDPathStr)
Este comentário foi feito pelo moderador no site
Oi skyyang, eu quero copiar ou mover arquivos (.jpg, .png) qualquer formato de pasta e suas subpastas. O script acima está copiando toda a pasta contendo o arquivo correspondente
Obrigado e cumprimentos,
Este comentário foi feito pelo moderador no site
OI, não sou especialista em VBA mas preciso do seu Módulo e fiz conforme você instruiu mas nada copiou da pasta de origem para a nova pasta. e nenhum erro é mostrado
Este comentário foi feito pelo moderador no site
E o que acontece se o arquivo não existir na pasta de origem?
o código quebra

O código deve ter uma linha para pular para outra referência caso não exista
Este comentário foi feito pelo moderador no site
Se a referência não existir a quebra de código
que linha devo ter para o código fazer um salto pela próxima referência sem parar
Este comentário foi feito pelo moderador no site
Como isso poderia ser adaptado para colar em uma lista de vários caminhos de arquivo em vez de um caminho por vez?
Este comentário foi feito pelo moderador no site
Olá, sabin,
Deseja copiar e colar os arquivos de várias pastas originais em vez de apenas uma pasta?
Este comentário foi feito pelo moderador no site
sim por favor
Não há comentários postados aqui ainda
carregar mais
Deixe o seu comentário
Postando como convidado
×
Avalie esta postagem:
0   Personagens
Locais sugeridos