Ir ao conteúdo
  • Cadastre-se

Excel Como agrupar vários arquivos excel em um só com várias abas?


LucasBR5
Ir à solução Resolvido por Midori,

Posts recomendados

Olá boa noite, tenho um arquivo excel com 33 abas contendo 33 planilhas iguais so que com dados diferentes, toda semana preciso atualizar essas 33 planilhas baixando arquivos novos copiando e colando, gostaria de saber se existe um jeito de eu conseguir so agrupar os 33 arquivos e abri-los todos em uma planilha so com 33 abas, sem precisar copiar e colar os novos dados toda vez

Screenshot_1.png

Screenshot_2.png

Link para o comentário
Compartilhar em outros sites

@Midori  não entendo muito disso, você conhece algum macro? ja tentei algumas vezes mas nenhum deles(que achei em tutoriais) pegou os arquivos, quando executava o comando so nao fazia nada

adicionado 0 minutos depois

@gmbatista não entendo muito disso, você conhece algum macro? ja tentei algumas vezes mas nenhum deles(que achei em tutoriais) pegou os arquivos, quando executava o comando so nao fazia nada

Link para o comentário
Compartilhar em outros sites

@LucasBR5  Para abrir os arquivos podemos usar um loop com a função Dir no diretório dos arquivos,

 

Sub Macro()
    Dim Arquivo     As String
    Dim Diretorio   As String
    Dim Pasta       As Workbook
    Dim Planilha    As Worksheet
    
    Diretorio = "C:\Teste\"
    Arquivo = Dir(Diretorio & "*.xlsx")
    
    Do Until Arquivo = ""
        Set Pasta = Workbooks.Open(Diretorio & Arquivo)
            Pasta.ActiveSheet.[A1].CurrentRegion.Copy
            
            ThisWorkbook.Worksheets.Add
            ThisWorkbook.ActiveSheet.[A1].PasteSpecial
            
            Pasta.Close
            Arquivo = Dir
    Loop
End Sub

 

Faça um teste com a macro em uma nova planilha.

 

Todos os arquivos xlsx do diretório C:\Teste serão abertos e os dados da aba ativa na região do range A1 serão copiados e colados para a planilha da macro em abas que serão criadas para cada arquivo.

 

Mas como a sua planilha já tem as abas onde os dados devem ser colados, depois será preciso editar os comandos para colar nessas abas. Isso podemos adaptar se você der mais informações sobre os nomes ou padrão dessas abas.

 

  • Curtir 1
Link para o comentário
Compartilhar em outros sites

1 hora atrás, Midori disse:

@LucasBR5  Para abrir os arquivos podemos usar um loop com a função Dir no diretório dos arquivos,

 


Sub Macro()
    Dim Arquivo     As String
    Dim Diretorio   As String
    Dim Pasta       As Workbook
    Dim Planilha    As Worksheet
    
    Diretorio = "C:\Teste\"
    Arquivo = Dir(Diretorio & "*.xlsx")
    
    Do Until Arquivo = ""
        Set Pasta = Workbooks.Open(Diretorio & Arquivo)
            Pasta.ActiveSheet.[A1].CurrentRegion.Copy
            
            ThisWorkbook.Worksheets.Add
            ThisWorkbook.ActiveSheet.[A1].PasteSpecial
            
            Pasta.Close
            Arquivo = Dir
    Loop
End Sub

 

Faça um teste com a macro em uma nova planilha.

 

Todos os arquivos xlsx do diretório C:\Teste serão abertos e os dados da aba ativa na região do range A1 serão copiados e colados para a planilha da macro em abas que serão criadas para cada arquivo.

 

Mas como a sua planilha já tem as abas onde os dados devem ser colados, depois será preciso editar os comandos para colar nessas abas. Isso podemos adaptar se você der mais informações sobre os nomes ou padrão dessas abas.

 

Funcionouu, muito obrigado fiquei procurando um dia todo por isso!!!, só uma pergunta, as planilhas começaram a ser importadas pelo primeiro arquivo (data.xlsx) ou na ordem de cima para baixo (data(1).xlxs ate data(33).xlsx e depois o data.xlsx)?

Se fosse para colocar cada planilha no seu devido lugar ja com nome na aba seria por ordem alfabetica, ou seja, data.xlsx iria para a aba "agrolandia", data(1).xlsx iria para "aguas mornas" e assim por diante ate o data(33).xlsx.

Os nomes das abas são na ordem

Agrolândia, Águas Mornas, Angelina, Anitápolis, Antonio Carlos, Apiuna, Araquari, Atalanta, Aurora, Biguaçu, Blumenau, Campo Alegre, Caxias do Sul, Chapadão do Lageado, Corupá, Gaspar, Imaruí, Imbuia, Ituporanga, Jaraguá do Sul, Leoberto Leal, Massaranduba, Palhoça, Petrolândia, Pomerode, Rancho Queimado, Rodeio, Santo Amaro da Imperatriz, São Bento do Sul, São João do Itaperiú, Schoroeder, Tijucas, Timbo, Vidal Ramos.

Desde já muito obrigado pela ajuda!

Link para o comentário
Compartilhar em outros sites

@LucasBR5  As planilhas são importadas sem ordem. O ideal seria se tivesse o nome da aba no próprio arquivo que será importado, mas se não tiver podemos usar o nome dos arquivos para especificar o índice da planilha e colocar as informações na ordem das abas desta forma,

 

Sub Macro()
    Dim Arquivo     As String
    Dim Diretorio   As String
    Dim Indice      As Integer
    Dim Pasta       As Workbook
    Dim Planilha    As Worksheet
    
    Diretorio = "C:\Teste\"
    Arquivo = Dir(Diretorio & "*.xlsx")
    
    Do Until Arquivo = ""
        If InStr(Arquivo, "(") And InStr(Arquivo, ")") Then
            Indice = Split(Split(Arquivo, "(")(1), ")")(0) + 1
        Else
            Indice = 1
        End If
        
        Set Pasta = Workbooks.Open(Diretorio & Arquivo)
            Pasta.ActiveSheet.[A1].CurrentRegion.Copy
            ThisWorkbook.Worksheets(Indice).[A1].PasteSpecial
            Pasta.Close
            Arquivo = Dir
    Loop
End Sub

 

Assim o arquivo xlsx do diretório C:\Teste que não tiver número entre parênteses será copiado para a primeira aba da planilha, o arquivo que tiver (1) para a segunda aba, (2) para a terceira, etc.

  • Curtir 1
Link para o comentário
Compartilhar em outros sites

24 minutos atrás, Midori disse:

@LucasBR5  As planilhas são importadas sem ordem. O ideal seria se tivesse o nome da aba no próprio arquivo que será importado, mas se não tiver podemos usar o nome dos arquivos para especificar o índice da planilha e colocar as informações na ordem das abas desta forma,

 


Sub Macro()
    Dim Arquivo     As String
    Dim Diretorio   As String
    Dim Indice      As Integer
    Dim Pasta       As Workbook
    Dim Planilha    As Worksheet
    
    Diretorio = "C:\Teste\"
    Arquivo = Dir(Diretorio & "*.xlsx")
    
    Do Until Arquivo = ""
        If InStr(Arquivo, "(") And InStr(Arquivo, ")") Then
            Indice = Split(Split(Arquivo, "(")(1), ")")(0) + 1
        Else
            Indice = 1
        End If
        
        Set Pasta = Workbooks.Open(Diretorio & Arquivo)
            Pasta.ActiveSheet.[A1].CurrentRegion.Copy
            ThisWorkbook.Worksheets(Indice).[A1].PasteSpecial
            Pasta.Close
            Arquivo = Dir
    Loop
End Sub

 

Assim o arquivo xlsx do diretório C:\Teste que não tiver número entre parênteses será copiado para a primeira aba da planilha, o arquivo que tiver (1) para a segunda aba, (2) para a terceira, etc.

Desta forma copiou alguns arquivos na ordem porém outros não, pelo que notei ele copiou primeiro o data(1), depois o data(10), em seguida o 11 e ate o 19, depois copiou o 2, 20, 21, 22..., 29, 3, 30,31...,33, ai depois o 4, 5..., ate o 9.

Segue os arquivos se quiser modifica-los e testar, se não for incômodo. desde ja obrigado.

Teste.rar previsao do tempo 17.08.2020.xlsx

Link para o comentário
Compartilhar em outros sites

@LucasBR5 Faltou uma instrução no If para rodar corretamente. Macro corrigida,

 

Sub Macro()
    Dim Arquivo     As String
    Dim Diretorio   As String
    Dim Indice      As Integer
    Dim Pasta       As Workbook
    Dim Planilha    As Worksheet
    
    Diretorio = "C:\Teste\"
    Arquivo = Dir(Diretorio & "*.xlsx")
    
    Do Until Arquivo = ""
        If InStr(Arquivo, "(") <> 0 And InStr(Arquivo, ")") <> 0 Then
            Indice = Split(Split(Arquivo, "(")(1), ")")(0) + 1
        Else
            Indice = 1
        End If
        
        Set Pasta = Workbooks.Open(Diretorio & Arquivo)
            Pasta.ActiveSheet.[A1].CurrentRegion.Copy
            ThisWorkbook.Worksheets(Indice).[A1].PasteSpecial
            Application.CutCopyMode = False
            Pasta.Close
            Arquivo = Dir
    Loop
End Sub

 

  • Amei 1
Link para o comentário
Compartilhar em outros sites

33 minutos atrás, Midori disse:

@LucasBR5 Faltou uma instrução no If para rodar corretamente. Macro corrigida,

 


Sub Macro()
    Dim Arquivo     As String
    Dim Diretorio   As String
    Dim Indice      As Integer
    Dim Pasta       As Workbook
    Dim Planilha    As Worksheet
    
    Diretorio = "C:\Teste\"
    Arquivo = Dir(Diretorio & "*.xlsx")
    
    Do Until Arquivo = ""
        If InStr(Arquivo, "(") <> 0 And InStr(Arquivo, ")") <> 0 Then
            Indice = Split(Split(Arquivo, "(")(1), ")")(0) + 1
        Else
            Indice = 1
        End If
        
        Set Pasta = Workbooks.Open(Diretorio & Arquivo)
            Pasta.ActiveSheet.[A1].CurrentRegion.Copy
            ThisWorkbook.Worksheets(Indice).[A1].PasteSpecial
            Application.CutCopyMode = False
            Pasta.Close
            Arquivo = Dir
    Loop
End Sub

 

PERFEITO! Funcionou tudo certinho, na ordem e muito rápido, muito obrigado mesmo pela ajuda isso vai me ajudar demais no trabalho, te desejo tudo de bom! hahaha

Link para o comentário
Compartilhar em outros sites

  • 6 meses depois...
Em 19/08/2020 às 11:14, Midori disse:

@LucasBR5  As planilhas são importadas sem ordem. O ideal seria se tivesse o nome da aba no próprio arquivo que será importado, mas se não tiver podemos usar o nome dos arquivos para especificar o índice da planilha e colocar as informações na ordem das abas desta forma,

 



Sub Macro()
    Dim Arquivo     As String
    Dim Diretorio   As String
    Dim Indice      As Integer
    Dim Pasta       As Workbook
    Dim Planilha    As Worksheet
    
    Diretorio = "C:\Teste\"
    Arquivo = Dir(Diretorio & "*.xlsx")
    
    Do Until Arquivo = ""
        If InStr(Arquivo, "(") And InStr(Arquivo, ")") Then
            Indice = Split(Split(Arquivo, "(")(1), ")")(0) + 1
        Else
            Indice = 1
        End If
        
        Set Pasta = Workbooks.Open(Diretorio & Arquivo)
            Pasta.ActiveSheet.[A1].CurrentRegion.Copy
            ThisWorkbook.Worksheets(Indice).[A1].PasteSpecial
            Pasta.Close
            Arquivo = Dir
    Loop
End Sub

 

Assim o arquivo xlsx do diretório C:\Teste que não tiver número entre parênteses será copiado para a primeira aba da planilha, o arquivo que tiver (1) para a segunda aba, (2) para a terceira, etc.

Olá boa tarde, depois de muito tempo com esse macro funcionando perfeitamente o sistema mudou, agora os arquivos são baixados com os nomes iguais aos da planilha (como você disse ser o ideal ) e não os números como você corrigiu, o que posso fazer para alterar para que os arquivos sejam abertos, copiados e colados em ordem alfabética? Desde ja muito obrigado.

Link para o comentário
Compartilhar em outros sites

  • Solução

@LucasBR5 Se todos os arquivos têm o mesmo nome das abas, assim deve resolver,

 

Sub Macro()
    Dim Arquivo     As String
    Dim Diretorio   As String
    Dim Pasta       As Workbook
    
    Diretorio = "C:\Teste\"
    Arquivo = Dir(Diretorio & "*.xlsx")
    
    Do Until Arquivo = ""
        Set Pasta = Workbooks.Open(Diretorio & Arquivo)
            Pasta.ActiveSheet.[A1].CurrentRegion.Copy
            ThisWorkbook.Worksheets( _
                Replace(Arquivo, ".xlsx", "")).[A1].PasteSpecial
            Pasta.Close
            Arquivo = Dir
    Loop
End Sub

 

  • Amei 1
Link para o comentário
Compartilhar em outros sites

31 minutos atrás, Midori disse:

@LucasBR5 Se todos os arquivos têm o mesmo nome das abas, assim deve resolver,

 


Sub Macro()
    Dim Arquivo     As String
    Dim Diretorio   As String
    Dim Pasta       As Workbook
    
    Diretorio = "C:\Teste\"
    Arquivo = Dir(Diretorio & "*.xlsx")
    
    Do Until Arquivo = ""
        Set Pasta = Workbooks.Open(Diretorio & Arquivo)
            Pasta.ActiveSheet.[A1].CurrentRegion.Copy
            ThisWorkbook.Worksheets( _
                Replace(Arquivo, ".xlsx")).[A1].PasteSpecial
            Pasta.Close
            Arquivo = Dir
    Loop
End Sub

 

Olá bom dia, apareceu o erro "Erro de compilação: o argumento não é opcional"

Screenshot_1.png

Link para o comentário
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

Como se tornar um desenvolvedor full-stack

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!