Ir ao conteúdo
  • Cadastre-se

Macro para consolidação de planilhas


Posts recomendados

Bom dia, 

Já pesquisei em diversos lugares no fórum e não encontro uma solução para incrementar o código.
Possuo dois arquivos X1 e X2.
No arquivo X1 eu digito as informações de acordo com o que os Estados vão enviando. Atualmente este arquivo deve ter 12 planilhas.
No arquivo X2 possui um código VBA, onde na primeira planilha eu defino o caminho onde a X1 está e executo uma macro que consolida as informações das 12 planilhas do arquivo X1, na segunda planilha. 

Hoje a planilha consolidado, do arquivo X2, está com um total de 1161 linhas e a tendência é aumentar cada vez mais. Porém o arquivo está se tornando pesado e difícil de se manusear.

Eu gostaria de incrementar o código VBA para puxar somente os valores do mês que estiver especificado na coluna D, primeira planilha.

 

Estou copiando abaixo o código. Eu tentei anexar o arquivo porém diz que eu não tenho permissão para fazer upload deste tipo de arquivo.
 

Sub lsConsolidarPlanilhas()    Dim lWorkbook           As Workbooks    Dim lWorksheet          As Worksheet    Dim lUltimaLinhaAtiva   As Long    Dim lControle           As Long    Dim lUltimaLinhaAtiva2  As Long    Dim lUltimaLinhaAtiva3  As Long        Application.DisplayAlerts = False    Application.ScreenUpdating = False        Worksheets("Consolidado").Select    Worksheets("Consolidado").Range("A2:G1000000").Select    Selection.ClearContents            lUltimaLinhaAtiva = Worksheets("Configuração").Cells(Worksheets("Configuração").Rows.Count, 1).End(xlUp).Row    lControle = 2        While lControle <= lUltimaLinhaAtiva        Workbooks.Open Filename:=Worksheets("Configuração").Range("A" & lControle).Value                    Set lworkbooks = ActiveWorkbook                    For Each lWorksheet In lworkbooks.Worksheets            If (lWorksheet.Name = Workbooks("CONTROLE DE MANUTENÇÃO EQUIPAMENTOS.xlsm").Worksheets("Configuração").Range("B" & lControle).Value Or _                Workbooks("CONTROLE DE MANUTENÇÃO EQUIPAMENTOS.xlsm").Worksheets("Configuração").Range("B" & lControle).Value = "") Then                                Workbooks(lworkbooks.Name).Worksheets(lWorksheet.Name).Activate                lUltimaLinhaAtiva2 = Worksheets(lWorksheet.Name).Cells(Worksheets(lWorksheet.Name).Rows.Count, 1).End(xlUp).Row                lWorksheet.Select                lWorksheet.Range("A2:" & Workbooks("CONTROLE DE MANUTENÇÃO EQUIPAMENTOS.xlsm").Worksheets("Configuração").Range("C" & lControle).Value & lUltimaLinhaAtiva2).Select                Selection.Copy                                lUltimaLinhaAtiva3 = Workbooks("CONTROLE DE MANUTENÇÃO                     EQUIPAMENTOS.xlsm").Worksheets("Consolidado").Cells(Workbooks("CONTROLE DE MANUTENÇÃO EQUIPAMENTOS.xlsm").Worksheets("Consolidado").Rows.Count, 1).End(xlUp).Row + 1                Workbooks("CONTROLE DE MANUTENÇÃO EQUIPAMENTOS.xlsm").Worksheets("Consolidado").Activate                Workbooks("CONTROLE DE MANUTENÇÃO EQUIPAMENTOS.xlsm").Worksheets("Consolidado").Range("A" & lUltimaLinhaAtiva3).Select                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _                    :=False, Transpose:=False            End If        Next lWorksheet                Workbooks(lworkbooks.Name).Close                lControle = lControle + 1    Wend        Worksheets("Configuração").Select    Worksheets("Configuração").Range("A1").Select        Application.DisplayAlerts = True    Application.ScreenUpdating = True        MsgBox "Planilhas consolidadas!"        End Sub

 

Macro para consolidação de planilhas.rar

Link para o comentário
Compartilhar em outros sites

  • Membro VIP

Bom dia AFC

 

Para anexar arquivos com Macros, é necessário compactar o arquivo, para evitar a proliferação de arquivos com códigos maliciosos.

 

Editei o tópico do teu título, pois conforme as regras do fórum, no título, deve constar apenas um resumo da dúvida,  não sendo permitido a utilização de palavras como "Ajuda"; "Help"; "Urgente", pois atrapalham a pesquisa no fórum.

 

[]s

 

Patropi - Moderação

Link para o comentário
Compartilhar em outros sites

Bom dia AFC

 

Para anexar arquivos com Macros, é necessário compactar o arquivo, para evitar a proliferação de arquivos com códigos maliciosos.

 

Editei o tópico do teu título, pois conforme as regras do fórum, no título, deve constar apenas um resumo da dúvida,  não sendo permitido a utilização de palavras como "Ajuda"; "Help"; "Urgente", pois atrapalham a pesquisa no fórum.

 

[]s

 

Patropi - Moderação

 

Obrigado pela ajuda.

É que vi outro tópico aqui escrito ajuda, não imaginei que teria problemas.

Link para o comentário
Compartilhar em outros sites

Fiz extermínio de Select/Activate no seu código. Deixei somente 2 lá no final.

 

Alterei o intervalo que é replicado de cada planilha. O seu código copia de "A:J", e eu alterei para copiar de "A:L", com isso elimina as fórmulas da planilha "Consolidado", coluna "L", tornando-a menos "pesada". Retorne se precisar desfazer essa alteração.

 

Acrescentei os comandos para copiar somente os registros cujo mês é igual ao mês da coluna "D" da planilha "Configuração".

 

Teste o código em uma cópia do seu arquivo.

Sub lsConsolidarPlanilhasNovo()    Dim lWorkbook           As Workbook    Dim lWorksheet          As Worksheet    Dim lUltimaLinhaAtiva   As Long    Dim lControle           As Long    Dim lUltimaLinhaAtiva2  As Long    'Dim lUltimaLinhaAtiva3  As Long    Dim strMês As String    Application.DisplayAlerts = False    Application.ScreenUpdating = False        With Sheets("Consolidado")      .Range(.Cells(2, 1), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).ClearContents    End With        lUltimaLinhaAtiva = Sheets("Configuração").Cells(Rows.Count, 1).End(xlUp).Row    lControle = 2        While lControle <= lUltimaLinhaAtiva       Workbooks.Open Filename:=ThisWorkbook.Sheets("Configuração").Range("A" & lControle).Value        strMês = Format(ThisWorkbook.Sheets("Configuração").Range("D" & lControle).Value, "mm/dd/yy")        Set lWorkbook = ActiveWorkbook                    For Each lWorksheet In lWorkbook.Worksheets            If lWorksheet.Name = ThisWorkbook.Sheets("Configuração").Range("B" & lControle).Value Or _                ThisWorkbook.Sheets("Configuração").Range("B" & lControle).Value = "" Then                                With lWorksheet                  If Not .AutoFilterMode Then                    .[A1].AutoFilter                  End If                  lUltimaLinhaAtiva2 = .Cells(Rows.Count, 1).End(xlUp).Row                  .Range("A1:L" & lUltimaLinhaAtiva2).AutoFilter Field:=1, Criteria1:="<>"                  .Range("A1:L" & lUltimaLinhaAtiva2).AutoFilter Field:=1, Operator:= _                      xlFilterValues, Criteria2:=Array(1, strMês) 'variável para a data                    If (.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1) > 0 Then                      .Range("A2:L" & lUltimaLinhaAtiva2).SpecialCells(xlCellTypeVisible).Copy                        ThisWorkbook.Sheets("Consolidado").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues                    End If                  .[A1].AutoFilter                End With                End If        Next lWorksheet                Workbooks(lWorkbook.Name).Close                lControle = lControle + 1    Wend        Worksheets("Configuração").Select    Worksheets("Configuração").Range("A1").Select        Application.DisplayAlerts = True    Application.ScreenUpdating = True        MsgBox "Planilhas consolidadas!"        End Sub




 

Link para o comentário
Compartilhar em outros sites

Funcionou, perfeitamente!!! 

Quanto a alteração que fez expandido de A:J para A:L, por enquanto não me atrapalha em nada.

 

porém esta acontecendo o seguinte, se na planilha configuração eu informar outro mês, como dezembro de 2014 e executar a macro. Na planilha consolidado ele salta varias linhas e começa a consolidação na linha 269; se coloca 01/2015 começa na 849 ... 

 

Tem como definir para que subscreva a informação existente na planilha consolidado e começa a partir da Célula A2, sempre ?

 

Quanto ao tamanho realmente esta gigante, a planilha já está com 5 mb e nem esta executando mais a macro, de tão pesada. Se não desmembrar por mês não vou conseguir trabalhar nela.....

 

Abraço,

Link para o comentário
Compartilhar em outros sites

... porém esta acontecendo o seguinte, se na planilha configuração eu informar outro mês, como dezembro de 2014 e executar a macro. Na planilha consolidado ele salta varias linhas e começa a consolidação na linha 269; se coloca 01/2015 começa na 849 ... 

Como você está colocando o mês/ano na célula de controle? É preciso colocar assim: para buscar registros de dezembro de 2014, coloque 1/12/2014; se quiser buscar de janeiro de 2015, coloque 1/1/2015.

 

 

Tem como definir para que subscreva a informação existente na planilha consolidado e começa a partir da Célula A2, sempre ?

O código sempre começará a replicar os registros em "A2".

 

Quanto ao tamanho realmente esta gigante, a planilha já está com 5 mb e nem esta executando mais a macro, de tão pesada. Se não desmembrar por mês não vou conseguir trabalhar nela.....

Talvez excluindo as fórmulas, se houver, melhore o desempenho da planilha. Exemplo: se houver fórmulas na coluna "L", selecione a coluna toda > > Copiar >> Colar especial >> Valores.

Por tratar-se de planilha de consolidação as fórmulas não são necessárias, pois em planilha consolidada não há alterações de valor, portanto, não há motivo para a existência de formulas nela.

Link para o comentário
Compartilhar em outros sites

 

... porém esta acontecendo o seguinte, se na planilha configuração eu informar outro mês, como dezembro de 2014 e executar a macro. Na planilha consolidado ele salta varias linhas e começa a consolidação na linha 269; se coloca 01/2015 começa na 849 ... 

Como você está colocando o mês/ano na célula de controle? É preciso colocar assim: para buscar registros de dezembro de 2014, coloque 1/12/2014; se quiser buscar de janeiro de 2015, coloque 1/1/2015.

 

r: Beleza, deu certo fazendo desta forma.

 

Tem como definir para que subscreva a informação existente na planilha consolidado e começa a partir da Célula A2, sempre ?

O código sempre começará a replicar os registros em "A2".

 

r: Se executar a marco de conciliação de planilha, mais de uma vez não começa na "A2".

 

Quanto ao tamanho realmente esta gigante, a planilha já está com 5 mb e nem esta executando mais a macro, de tão pesada. Se não desmembrar por mês não vou conseguir trabalhar nela.....

Talvez excluindo as fórmulas, se houver, melhore o desempenho da planilha. Exemplo: se houver fórmulas na coluna "L", selecione a coluna toda > > Copiar >> Colar especial >> Valores.

Por tratar-se de planilha de consolidação as fórmulas não são necessárias, pois em planilha consolidada não há alterações de valor, portanto, não há motivo para a existência de formulas nela.

 

r: Estou fazendo isso, e realmente está bem menor.

Link para o comentário
Compartilhar em outros sites

 

 

Tem como definir para que subscreva a informação existente na planilha consolidado e começa a partir da Célula A2, sempre ?

O código sempre começará a replicar os registros em "A2".

r: Se executar a marco de conciliação de planilha, mais de uma vez não começa na "A2".

 

 

É estranho, pois o código limpa a planilha "Consolidado", deixando somente o cabeçalho na linha 1.

Em seguida verifica as planilhas do arquivo "CONSUMO DE OLEO" e a primeira, cujos registros atendam ao critério da data, as linhas correspondentes são replicadas na planilha "Consolidado" a partir da célula "A2".

Se o problema persiste seria interessante você disponibilizar o arquivo com o código instalado.

Link para o comentário
Compartilhar em outros sites

Visitante
Este tópico está impedido de receber novas respostas.

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