Criar pasta, move o arquivo e Abrir em VBA

[jordan_jd]

Boa tarde galera

 

Estou tendo um problema com o código abaixo, primeiro ele copia um arquivo base "meu", renomeia com o numero que esta na célula e depois ele abrir.

 

Agora eu quero mover o arquivo renomeado e abri-lo em seguida mas não estou conseguindo alguém pode me ajudar.

 

Sub Copy_Abrir()
FileCopy "D:\Users\Jordan\Desktop\WEb\Teste\teste.xlsx", "D:\Users\Jordan\Desktop\WEb\Teste\teste 1.xlsx"

    Dim caminlho As String
    Dim pasta As Object, Nomepasta

Application.ScreenUpdating = False
    
'Seleciona a última linha preenchida da planilha
 Linha = Sheets("Orcamento").Cells(Rows.Count, "A").End(xlUp)
 Cliente = Sheets("Orcamento").Cells(Rows.Count, "B").End(xlUp)
 Obra = Sheets("Orcamento").Cells(Rows.Count, "C").End(xlUp)

    'Cria pasta com o numero do orçamento que esta na ultima linha escrita da coluna A
    Set pasta = CreateObject("Scripting.FileSystemObject")
    Nomepasta = ActiveWorkbook.Path & "\" & Linha
    
     If Not pasta.FolderExists(Nomepasta) Then
    pasta.CreateFolder (Nomepasta)
    End If
    
        'Nome na Planilha Ativa em A2
        nomeA2 = CStr(Linha & " - " & Cliente & " - " & Obra)
        
        On Error Resume Next

        'Define os Novos Nomes - Planilha(Arquivo)
        novoNome = nomeA2

        'Enibe a mensagem se a pasta já existir
        'Com essa instrução a Pasta será substiutida sem questionamento
        Application.DisplayAlerts = False
 
    'Como renomear arquivos (exemplo):
    Name "D:\Users\Jordan\Desktop\WEb\Teste\teste 1.xlsx" As "D:\Users\Jordan\Desktop\WEb\Teste\" & novoNome & ".xlsx"

'AQUI SERA PARA MOVER PARA A PASTA CRIADA
Name "D:\Users\Jordan\Desktop\WEb\Teste" & "\" & novoNome & ".xlsx" As "D:\Users\Jordan\Desktop\WEb\Teste" & "\" & Nomepasta & novoNome & ".xlsx"

'AQUI ABRIR O ARQUIVO MOVIDO
    Workbooks.Open ("D:\Users\Jordan\Desktop\WEb\Teste" & "\" & Nomepasta & novoNome & ".xlsx")

End Sub

 

[CasaDoHardware]

Nao é mais fácil salvar como o arquivo no novo local, novo nome e mante-lo aberto?

 

A base do codigo da pra fazer ate com o gravador de macros.

[jordan_jd]

Boa tarde Galera

 

consegui fazer alterando a linha abaixo.

 

Esta Linha:

    'Como renomear arquivos (exemplo):
    Name "D:\Users\Jordan\Desktop\WEb\Teste\teste 1.xlsx" As "D:\Users\Jordan\Desktop\WEb\Teste\" & novoNome & ".xlsx"

 

Por : 

 

    'Como renomear arquivos (exemplo):
    Name "D:\Users\Jordan\Desktop\WEb\Teste\teste 1.xlsx" As "D:\Users\Jordan\Desktop\WEb\Teste\" & Linha & "\" & novoNome & ".xlsx"

 

Esta pode excluir:

 

 'AQUI SERA PARA MOVER PARA A PASTA CRIADA
  Name "D:\Users\Jordan\Desktop\WEb\Teste" & "\" & novoNome & ".xlsx" As "D:\Users\Jordan\Desktop\WEb\Teste" & "\" & Nomepasta & novoNome & ".xlsx"