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

[LucasBR5]

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

[Midori]

@LucasBR5 Isso pode ser feito com macro para ir abrindo todos os arquivos xlsx do diretório e colando os dados de cada um na planilha.

 

[gmbatista]

Tenho uma macro que faz isso.

[LucasBR5]

@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

[Midori]

@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.

 

[LucasBR5]

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!

[Midori]

@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.

[LucasBR5]

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

[Midori]

@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

 

[LucasBR5]

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

[Patropi]

@LucasBR5

 

Para responder use a janela de resposta que fica logo abaixo da última resposta, não use a ferramenta Citar sem necessidade, pois poluí o fórum.

 

Você se esqueceu de clicar na mãozinha para curtir as respostas da Midori.

 

[]s

[LucasBR5]

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.

[Midori]

@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

 

[LucasBR5]

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"

[Midori]

@LucasBR5  Copie novamente, já está corrigido.

[LucasBR5]

10 minutos atrás, Midori disse:

@LucasBR5  Copie novamente, já está corrigido.

Fechou, funcionou perfeitamente, mais uma vez muito obrigado pela ajuda, me salvou hahaha. Obrigado e tenha um bom dia!

[Luiz Filipe Porto]

Em 09/03/2021 às 08:57, LucasBR5 disse:

 

Boa noite. Estou tentando usar essa macro para compilar diversas planilhas em uma só, mesma situação que você. Estou sem êxito.. você poderia me explicar de forma detalhada como você usa(va) esse código? Obrigado!

Em 09/03/2021 às 08:46, Midori disse:

se possível, midori, poderia me explicar você também?

 

[Midori]

@Luiz Filipe Porto Sem exito em que sentido? A macro busca as planilhas no diretório passado para a variável Diretorio. E o código pega toda a região da tabela de cada planilha a partir de A1. Caso a sua comece em outra célula edite a linha do CurrentRegion.

[Luiz Filipe Porto]

@Midori esse é o erro que aparece: 

 

 

 

Não entendo o porque desse "Testetestelucro", uma vez que o diretório que inseri é esse: C:\Users\luizf\Downloads\Teste 

 

 

 

 

 

 

Após a mensagem de erro (primeiro print), essa linha do código é sublinhada em amarelo 

[Midori]

28 minutos atrás, Luiz Filipe Porto disse:

Não entendo o porque desse "Testetestelucro", uma vez que o diretório que inseri é esse: C:\Users\luizf\Downloads\Teste 

Faltou a barra no final, sem ela o nome do arquivo será concatenado com Teste.

[Luiz Filipe Porto]

@Midori dessa forma?

[Midori]

@Luiz Filipe Porto É assim mesmo.

[Luiz Filipe Porto]

@Midori consegui passar daquela etapa. agora o erro é o seguinte 

 

 

 

[Midori]

@Luiz Filipe Porto Acho melhor criar outro tópico para resolver isso.

[Luiz Filipe Porto]

@Midori criarei o tópico agora