Copiar planilhas de uma pasta para outra com VBA

Buenas!

Caros, uso o código abaixo (acho que é do JPaulo, perdão se for de outro) para copiar uma planilha de uma pasta para outra.

   Set fso = New FileSystemObject
   'Definir a pasta de origem
   Set orgFolder = fso.GetFolder(PastaCopiar)
   'Definir o "spec" do ficheiro a encontrar (parte do nome)
   strFileToFind = NomeDaPlanilha
   
   'Percorrer os ficheiros da pasta
   For Each actFile In orgFolder.Files
     If actFile.Name = strFileToFind Then
           'Se encontrar, copia
       actFile.Copy (PastaCopiado & Replace(actFile.Name, "XX", "Copia"))
           'Sai, para o caso de haver um 2º ficheiro
           Exit For
       End If
   Next


Agora, quero copiar várias planilhas de uma mesma pasta, cada uma para sua pasta própria. O nome de cada planilha tem uma parte fixa e a outra a data de sua geração: Nomefixo_yyyymmdd.xls.
Isso será feito rotineiramente, até três vezes por semana.

Pensei em criar uma tabela para registrar: Nome_da_planilha (parte fixa), Pasta onde está a planilha (PastaCopiar) e Pasta onde será copiada a planilha (PastaCopiado).
Porém, não sei como colocar isso no código.

Se alguém se dispuser a ajudar, agradeço.

Buenas!

Achei este codigo, do JPaulo:

'Copiar todos os ficheiros de uma pasta para outra pasta:


Sub CopiaTodosOsFicheiros()
Dim fso
Dim sfol As String, dfol As String
sfol = "c:\SuaPasta" ' caminho de origem da pasta
dfol = "e:\SuaPasta" ' caminho de destino da pasta
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
If Not fso.FolderExists(sfol) Then
MsgBox sfol & " caminho invalido.", vbInformation, "Erro"
ElseIf Not fso.FolderExists(dfol) Then
MsgBox dfol & " caminho invalido.", vbInformation, "Erro"
Else
fso.CopyFile (sfol & "\*.*"), dfol ' Alterar "\ *.*" para "\ *. xls" para mover só arquivos Excel
End If
If Err.Number = 53 Then MsgBox "não encontrado."
End Sub


A questão é como copiar cada um dos arquivos para sua pasta de destino.
Ou os diretórios de destino ficam numa tabela ou colocados no código. Aí é que eu não sei adaptar o código.

Buenas!
Então, alguém pra me dar uma dica?

Buenas!

Pensei em algo do tipo, com a tabela das informações que preciso para copiar as planilhas:

Indice..........PlanilhaOrigem......................PlanilhaDestino.......................PastaOrigem.....................PastaDestino
1.....................Planilha001........................ Planilha_Balanco.....................\\C:PastaOrigem.................\\C:PastaPlanilha_Balanco
2.....................Planilha002........................ Planilha_Processos .....................\\C:PastaOrigem.................\\C:PastaPlanilha_Processos
3.....................Planilha003........................ Planilha_Resultados .....................\\C:PastaOrigem.................\\C:PastaPlanilha_Resultados


O código, a desenvolver, percorreria a pasta PastaOrigem e, a cada planilha encontrada, identificaria o seu nome na tabela acima (PlanilhaOrigem).
Então, copia a planilha (ex: Planilha001) para a PastaDestino (\\C:PastaPlanilha_Balanco) com o nome Planilha_Balanco).

Ou partindo da tabela, procurando na PastaOrigem, a primeira planilha (Indice 1) e copiando-a para a sua PastaDestino.

Obrigado.

Tente esse código de exemplo ai ele utiliza o Shell para fazer as copias...
tentei deixar tudo explicado nos comentários do código

Código:


'função para copiar arquivos para pastas
Function copiarPlanilhas()
Dim vPastaOrigem, vPastaBalanco, vPastaProcesso, vPastaResultado, boArquivo1, boArquivo2, boArquivo3

'Pasta origem CurrentProject.Path e a pasta onde o BD fica
vPastaOrigem = CurrentProject.Path & "\PastaOrigem\"

'Pastas de destinos das planilhas
vPastaBalanco = CurrentProject.Path & "\PastaPlanilha_Balanco\"
vPastaProcesso = CurrentProject.Path & "\PastaPlanilha_Processo\"
vPastaResultado = CurrentProject.Path & "\PastaPlanilha_Resultado\"

'Variaveis Booleanas se retornar True (verdadeiro) existe arquivos desse tipo as pastas
boArquivo1 = Not (Len(Dir(vPastaOrigem & "Planilha001*.xlsx")) = 0)
boArquivo2 = Not (Len(Dir(vPastaOrigem & "Planilha002*.xlsx")) = 0)
boArquivo3 = Not (Len(Dir(vPastaOrigem & "Planilha003*.xlsx")) = 0)


'verifica se existe arquivos *.xlsx na pasta
If Not Len(Dir(vPastaOrigem & "*.xlsx")) = 0 Then
  'se existir
  If boArquivo1 Then
  'copia arquivos que comece com Planilha001 para a pasta contida na variavel vPastaBalanco e deleta o arquivo de origem
  Shell "cmd.exe /C xcopy " & vPastaOrigem & "Planilha001*.xlsx " & vPastaBalanco & _
        " && " & "del " & vPastaOrigem & "Planilha001*.xlsx", vbHide
  End If
  If boArquivo2 Then
  'copia arquivos que comece com Planilha001 para a pasta contida na variavel vPastaBalanco e deleta o arquivo de origem
  Shell "cmd.exe /C xcopy " & vPastaOrigem & "Planilha002*.xlsx " & vPastaProcesso & _
        " && " & "del " & vPastaOrigem & "Planilha002*.xlsx", vbHide
  End If
  If boArquivo3 Then
  'copia arquivos que comece com Planilha001 para a pasta contida na variavel vPastaBalanco e deleta o arquivo de origem
  Shell "cmd.exe /C xcopy " & vPastaOrigem & "Planilha003*.xlsx " & vPastaResultado & _
        " && " & "del " & vPastaOrigem & "Planilha003*.xlsx", vbHide
  End If
Else
    'não existe arquivos *.xlsx na pasta
    MsgBox "Não tem arquivos xlsx Na Pasta para Poder ser copiado"
End If

End Function