Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Copiar Abas
 
Notifications
Clear all

Copiar Abas

 
2024 - VBA & Macros
Post Recente por romanholi 7 anos atrás
9 Posts
3 Usuários
0 Reactions
1,238 Visualizações
RSS
 romanholi
(@romanholi)
Posts: 177
Estimable Member
Topic starter
 

Pessoal, bom dia!

Mensalmente eu gero um arquivo em Excel com diversas abas de diversos outros arquivos. E tenho feito manual. Abro arquivo por arquivos, clico na aba que eu quero com o botão direito do mouse em mover ou copiar e faço uma copia da planilha no arquivo que receberá todas as planilhas.

Como eu não aguento mais fazer esse procedimento, são mais de 30 arquivos, resolvi gravar uma macro. Fiz a macro abaixo e gostaria de saber de vocês:

Essa é a melhor opção para fazer isso?
Existe a possibilidade de eu não ver o processo de abrir o arquivo e copiar a planilha?
Como eu faço para fechar o arquivo de origem?

Veja a macro galera! Se puderem dar um toque para eu melhorar, antes de programar para os outros 30 arquivos:

Sub Gerar_Pasta_Final()

Dim Caminho As String
Dim DataNome As String


Caminho = "R:ResultadoResultado 20172017-042017-04 RES 101"
DataNome = Application.InputBox("Data Referente ao nome do arquivo", "Aviso", , Type:=2)


Sheets("Capa").Select

Range("D28") = Application.InputBox("Informa o Mês em Exercício", "Aviso", , Type:=1)


' PÁGINA 04

        
    ChDir Caminho
    
    Workbooks.Open Filename:=Caminho & "" & DataNome & " - 101 Producao_Mensal.xlsx"
    Sheets("Acomp_Prod_101").Select
    Sheets("Acomp_Prod_101").Copy Before:=Workbooks("Pasta Final.xlsx").Sheets(1)
    Windows("Pasta Final.xlsx").Activate
    ActiveSheet.Name = "04"
    
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B1:S1").Select
    Application.CutCopyMode = False
    
    
' PÁGINA 04






End Sub
 
Postado : 04/05/2017 7:06 am
 skulden
(@skulden)
Posts: 170
Estimable Member
 

para não ver todo o processo basta acrescentar:

application.screenupdating = False

...código...

application.screenupdating = True

End sub

para fechar o arquivo:

workbooks(nome).close

Se a resposta lhe foi útil, clique no joinha!

 
Postado : 04/05/2017 7:11 am
 romanholi
(@romanholi)
Posts: 177
Estimable Member
Topic starter
 

Skuden, bom dia!

Fiz da forma como indicastes, mas não funcionou. Ainda consigo ver a abertura do arquivo de origem. Não quero ver abrir o arquivo

Da forma como indicou:

Sub Gerar_Pasta_Final()

Application.ScreenUpdating = False

Dim Caminho As String
Dim DataNome As String


Caminho = "R:ResultadoResultado 20172017-042017-04 RES 101"
DataNome = Application.InputBox("Data Referente ao nome do arquivo", "Aviso", , Type:=2)


Sheets("Capa").Select

Range("D28") = Application.InputBox("Informa o Mês em Exercício", "Aviso", , Type:=1)


' PÁGINA 04 ---------------------------------**************-------------------------------------------

        
    ChDir Caminho
    
    Workbooks.Open Filename:=Caminho & "" & DataNome & " - 101 Producao_Mensal.xlsx"
    Sheets("Acomp_Prod_101").Select
    Sheets("Acomp_Prod_101").Copy Before:=Workbooks("Pasta Final.xlsx").Sheets(1)
    Windows("Pasta Final.xlsx").Activate
    ActiveSheet.Name = "04"
    
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B1:S1").Select
    Application.CutCopyMode = False
    
    Workbooks(DataNome & " - 101 Producao_Mensal.xlsx").Close
    
    
    
' PÁGINA 04




Application.ScreenUpdating = True


End Sub
 
Postado : 04/05/2017 7:46 am
 romanholi
(@romanholi)
Posts: 177
Estimable Member
Topic starter
 

Outro problema que está ocorrendo...
Quando o arquivo de origem tem vinculos externos.. aparece a mensagem
Esta pasta de trabalho contem vínculos... e mesmo colocando application.displayalerts=false continua aparecendo
Como resolver?

Sub Gerar_Pasta_Final()

Application.ScreenUpdating = False

Dim Caminho As String
Dim DataNome As String


Caminho = "R:ResultadoResultado 20172017-042017-04 RES 101"
DataNome = Application.InputBox("Data Referente ao nome do arquivo", "Aviso", , Type:=2)


Sheets("Capa").Select

Range("D28") = Application.InputBox("Informa o Mês em Exercício", "Aviso", , Type:=1)


' PÁGINA 04 ---------------------------------***********-------------------------------------------

On Error GoTo Pula04:

Application.DisplayAlerts = False

    Sheets("04").Select
    ActiveWindow.SelectedSheets.Delete
    
Pula04:

        
    ChDir Caminho
    
    Workbooks.Open Filename:=Caminho & "" & DataNome & " - 101 Producao_Mensal.xlsx"
    Sheets("Acomp_Prod_101").Select
    Sheets("Acomp_Prod_101").Copy Before:=Workbooks("Pasta Final.xlsx").Sheets(1)
    Windows("Pasta Final.xlsx").Activate
    ActiveSheet.Name = "04"
    
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B1:S1").Select
    Application.CutCopyMode = False
    
    With ActiveSheet.PageSetup
        .RightFooter = "04"
    End With
    
    Workbooks(DataNome & " - 101 Producao_Mensal.xlsx").Close
    

' PÁGINA 05 ---------------------------------********-------------------------------------------

On Error GoTo Pula05:

Application.DisplayAlerts = False

    Sheets("05").Select
    ActiveWindow.SelectedSheets.Delete
    
Pula05:

        
    ChDir Caminho
    
    Workbooks.Open Filename:=Caminho & "" & DataNome & " - 101 Producao_Mensal.xlsx"
    Sheets("Acomp_Prod_105").Select
    Sheets("Acomp_Prod_105").Copy Before:=Workbooks("Pasta Final.xlsx").Sheets(1)
    Windows("Pasta Final.xlsx").Activate
    ActiveSheet.Name = "05"
    
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B1:S1").Select
    Application.CutCopyMode = False
    
    With ActiveSheet.PageSetup
        .RightFooter = "05"
    End With
    
    Workbooks(DataNome & " - 101 Producao_Mensal.xlsx").Close
    
' PÁGINA 07 ---------------------------------***********-------------------------------------------

On Error GoTo Pula07:

Application.DisplayAlerts = False

    Sheets("07").Select
    ActiveWindow.SelectedSheets.Delete
    
Pula07:

        
    ChDir Caminho
    
    Workbooks.Open Filename:=Caminho & "" & DataNome & " - 101 Quadro_Funcionarios.xlsx"
    Sheets("Acomp_Folha_101").Select
    
        Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B1:S1").Select
    Application.CutCopyMode = False
    
    
    Sheets("Acomp_Folha_101").Copy Before:=Workbooks("Pasta Final.xlsx").Sheets(1)
    Windows("Pasta Final.xlsx").Activate
    ActiveSheet.Name = "07"
      
    
    With ActiveSheet.PageSetup
        .RightFooter = "07"
    End With
    
    Workbooks(DataNome & " - 101 Quadro_Funcionarios.xlsx").Close
    





Application.ScreenUpdating = True


End Sub
 
Postado : 04/05/2017 8:06 am
 romanholi
(@romanholi)
Posts: 177
Estimable Member
Topic starter
 

Inseir a linha
Workbooks.Open Filename:=Caminho & "" & DataNome & " - 101 Producao_Mensal.xlsx", UpdateLinks:=xlUpdateLinksNever

Resolver, não aparece mais a mensagem, porém o arquivo vem tudo como #VALOR!

Essa planilha em específico, é composta por muitos somases vinculadas a outro arquivo!

 
Postado : 04/05/2017 8:38 am
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

Eu dei uma olhada rapida, e vi que vc tem inputboxs que sao preenchidas pelo usuario e isso retarda o funcionamento das macros e faz com que vc veja a abertura dos arquivos.

O que se pode fazer é reescrever o codigo para que o mesmo fique mais rapido, talvez melhore ou evite essa percepçao de abertura do arquivo de origem.

Mas é certo que os inputs deveram ser removidos do codigo.

Mas para isso o ideal é vc disponibilizar os arquivos

Em resumo para que a percepção de abertura seja diminuida é necessario o minimo ou nenhuma interação do usuario durante a execução.

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 04/05/2017 8:49 am
 romanholi
(@romanholi)
Posts: 177
Estimable Member
Topic starter
 

Entendi, mas essa não é minha maior preocupação!

O meu maior problema é quando eu coloco UpdateLinks:=xlUpdateLinksNever para não aparecer a mensagem para atualizar vinculo, só que o relatório vem todo com #VALOR!

Não tem como disponibilizar esses arquivos meu amigo...Infelizmente!

Mas sem erro... eu fico clicando em não atualizar.... da forma como está já vou ganhar um tempão!
OBRIGADO

 
Postado : 04/05/2017 9:30 am
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

Precisa dos arquivos nao dos dados.

Os dados vc deve colocar informações nao reais.

Não é possivel usar os arquivos em vinculos?

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 04/05/2017 9:51 am
 romanholi
(@romanholi)
Posts: 177
Estimable Member
Topic starter
 

Então, são muitos arquivos! Mas relaxa! Não tem como disponibilizar, estão vinculados!

Gostaria que na aparecesse a mensagem "Esta pasta de trabalho contém vinculos com uma ou mais fontes.... (Atualizar / Não Atualizar / Ajuda)

O código está funcionando perfeitamente, queria apenas que não aparecesse a mensagem!

E quando eu coloco o código acima, por a planilha estar vinculada e ter muitos somases ela vem como #VALOR!

Mas tudo bem, vou clicando em não atualizar!

Obrigado

 
Postado : 04/05/2017 11:14 am
Forum Jump:
  Tópico Anterior
Próximo Tópico