Consolidar várias planilhas em uma só

[Alexandre Botura]

Pessoal, bom dia.

 

Precisava muito de uma macro que realizasse a consolidação de várias planilhas que possuo de vários centros de custo na empresa.

 

A ideia seria a seguinte:

Como possuo cerca de 30+ planilhas e dentro dessas planilhas existem várias abas, o primeiro passo seria consolidar dentro de cada planilha uma base parcial já das abas. Isso eu consegui fazer através do código: 

Sub Consolidar()

'consolida as abas do arquivo numa só

Dim ws As Worksheet
Dim LRo As Long
Dim LRd As Long

LRo = Sheets("Consolidado").Cells(Rows.Count, 1).End(xlUp).Row
If LRo > 1 Then Sheets("Consolidado").Range("A2:E" & LRo).ClearContents

For Each ws In ActiveWorkbook.Worksheets


If ws.Name <> "Consolidado" Then
LRo = ws.Cells(Rows.Count, 1).End(xlUp).Row

With Sheets("Consolidado")
LRd = .Cells(Rows.Count, 1).End(xlUp).Row
.Cells(LRd + 1, 1).Resize(LRo - 1, 5).Value = ws.Range("A2:E" & LRo).Value

End With
End If

Next ws

End Sub

Vou anexar o exemplo de 3 planilhas de centro de custo que primeiro serão consolidadas numa aba chamada "Consolidado" dentro da própria planilha. O código acima consolida todas as abas numa só a ideia é que isso fosse realizado automaticamente para que eu não precisasse abrir 30+ planilhas e fazer uma a uma.

 

Depois disso eu precisava que fosse consolidado em apenas uma BASE geral todas essas abas "Consolidado" das 30+ planilhas.

 

É possível fazer isso de modo automático? Todas as planilhas estariam dentro de um mesmo diretório e ai elas seriam abertas automaticamente, consolidadas e depois de consolidadas teriam que ser abertas novamente para serem consolidadas em apenas uma base geral. Acredito que deva possuir um modo mais fácil de fazer isso direto, do jeito que eu to falando (que eu pensei) seria em dois passos:

 

1º consolidar as abas dentro de cada planilha (com o código acima) porém ainda não sei deixar automático.

2º consolidar todos as abas "Consolidado" das 30+ planilhas numa planilha de base geral.

 

É possível realizar isso em apenas 1 passo? Copiar as abas das 30+ planilhas já direto para uma base geral?

 

 

Muito obrigado pessoal.

 

 

Centro de Custo2.xlsx

Centro de Custo3.xlsx

Centro de Custo1.xlsx

[Wendell Menezes]

Experimente assim (altere o nome da pasta com os arquivos a serem consolidados).

 

Eu incluí uma coluna adicional com o nome do arquivo e aba de onde os dados foram copiados para facilicar uma possível reconciliação manual, mas fica seu critério manter ou remover essa parte.

 

EDIT 1: Lembre-se que a macro deve ser acionada de um arquivo que não seja parte da consolidação.

Sub Consolidate_Workbooks()

Dim FSO As Object, wb As Object
Dim Folder As String, wbWIN As String
Dim wbNew As Workbook
Dim ws As Worksheet
Dim k As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Folder = "C:\Users\wende\Desktop\KSB1\" 'Pasta com as planilhas que serão abertas e copiadas

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set wbNew = Workbooks.Add
    For Each wb In FSO.GetFolder(Folder).Files
        If InStr(1, LCase(wb), ".xls") > 0 Then
            Workbooks.Open (wb)
            wbWIN = ActiveWorkbook.Name
                For Each ws In ActiveWorkbook.Worksheets
                    ws.Range("A" & IIf(k = 0, "1", "2") & ":E" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Copy
                    wbNew.Activate
                    Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
                    ActiveSheet.Paste
                        If k = 0 Then
                            Rows(1).Delete
                            Range("F1") = "FONTE"
                        End If
                    Range("F" & Cells(Rows.Count, 6).End(xlUp).Row + 1 & ":F" & Cells(Rows.Count, 1).End(xlUp).Row) = wbWIN & " - " & ws.Name
                    Windows(wbWIN).Activate
                    k = k + 1
                Next
            Application.CutCopyMode = False
            Workbooks(wbWIN).Close False
        End If
    Next
Application.ScreenUpdating = True
MsgBox k & " planilhas consolidadas com Sucesso!", vbInformation, "Aviso"
Application.Calculation = xlCalculationAutomatic

End Sub

 

[Alexandre Botura]

3 horas atrás, Wendell Menezes disse:

Experimente assim (altere o nome da pasta com os arquivos a serem consolidados).

 

Eu incluí uma coluna adicional com o nome do arquivo e aba de onde os dados foram copiados para facilicar uma possível reconciliação manual, mas fica seu critério manter ou remover essa parte.

 

EDIT 1: Lembre-se que a macro deve ser acionada de um arquivo que não seja parte da consolidação.

Sub Consolidate_Workbooks()

Dim FSO As Object, wb As Object
Dim Folder As String, wbWIN As String
Dim wbNew As Workbook
Dim ws As Worksheet
Dim k As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Folder = "C:\Users\wende\Desktop\KSB1\" 'Pasta com as planilhas que serão abertas e copiadas

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set wbNew = Workbooks.Add
    For Each wb In FSO.GetFolder(Folder).Files
        If InStr(1, LCase(wb), ".xls") > 0 Then
            Workbooks.Open (wb)
            wbWIN = ActiveWorkbook.Name
                For Each ws In ActiveWorkbook.Worksheets
                    ws.Range("A" & IIf(k = 0, "1", "2") & ":E" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Copy
                    wbNew.Activate
                    Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
                    ActiveSheet.Paste
                        If k = 0 Then
                            Rows(1).Delete
                            Range("F1") = "FONTE"
                        End If
                    Range("F" & Cells(Rows.Count, 6).End(xlUp).Row + 1 & ":F" & Cells(Rows.Count, 1).End(xlUp).Row) = wbWIN & " - " & ws.Name
                    Windows(wbWIN).Activate
                    k = k + 1
                Next
            Application.CutCopyMode = False
            Workbooks(wbWIN).Close False
        End If
    Next
Application.ScreenUpdating = True
MsgBox k & " planilhas consolidadas com Sucesso!", vbInformation, "Aviso"
Application.Calculation = xlCalculationAutomatic

End Sub

 

 

Oloco @Wendell Menezes , você é o bixo... muito obrigado.

 

Deixa eu só te perguntar uma coisa, deixando aplication.screenupdating como False implica em algo na fórmula ou apenas não vai ficar piscando o excel?

[Wendell Menezes]

Citação

deixando aplication.screenupdating como False implica em algo na fórmula ou apenas não vai ficar piscando o excel?

 

Geralmente o benefício desse recurso é que, na maioria das vezes, ele reduz o tempo de execução do script. Então eu costumo sempre utilizá-lo. Entretanto, não há nenhum impacto no resultado final.

[Alexandre Botura]

Perfeito @Wendell Menezes muito obrigado.

Vou deixar como False então. 

 

Uma outra coisa que é mais questão de refinamento mesmo, quando eu executo a macro de uma planilha x ela abre uma outra planilha y e consolida todas as informações nessa nova planilha y aberta. Não seria possível colar nessa planilha mesmo onde possui a macro? Pois ai eu deixaria esta planilha na rede e colocaria um botãozinho numa aba para apenas clicar e já atualizar as informações.

 

Não sei tem alguma interferência, mas a planilha se chamaria "Base Consolidada", na Aba "Base Geral" seria inserido todos os dados copiados e ai eu criaria um botãozinho numa outra aba ou até mesmo ao lado na mesma aba "Base Geral" para que qualquer pessoa aqui do setor possa clicar e atualizar.

 

Brigadão desde já.

[Wendell Menezes]

Sub Consolidate_Workbooks()

Dim FSO As Object, wb As Object
Dim Folder As String, wbWIN As String
Dim ws As Worksheet, wsTARGET As Worksheet
Dim k As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Folder = "C:\Users\wende\Desktop\KSB1\" 'Pasta com as planilhas que serão abertas e copiadas
Set wsTARGET = ThisWorkbook.Sheets("Base Geral") 'Aba em que os dados serão colados

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
    For Each wb In FSO.GetFolder(Folder).Files
        If InStr(1, LCase(wb), ".xls") > 0 Then
            Workbooks.Open (wb)
                For Each ws In ActiveWorkbook.Worksheets
                    ws.Range("A2:E" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Copy wsTARGET.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                    wsTARGET.Range("F" & wsTARGET.Cells(Rows.Count, 6).End(xlUp).Row + 1 & ":F" & wsTARGET.Cells(Rows.Count, 1).End(xlUp).Row) = ActiveWorkbook.Name & " - " & ws.Name
                    k = k + 1
                Next
            ActiveWorkbook.Close False
        End If
    Next
Application.ScreenUpdating = True
MsgBox k & " planilhas consolidadas com Sucesso!", vbInformation, "Aviso"
Application.Calculation = xlCalculationAutomatic

End Sub

 

[Alexandre Botura]

@Wendell Menezes muito obrigado velho, deu certo.

[João Carlos Júnior]

Boa noite.

 

Preciso de uma macro que consolide as pastas , como segue exemplo em anexo.

 

1.Na pasta DF- Cons.Ativo consolidar as contas para Cons.Ativo e assim sucessivamente para as outras pastas

2.Inverter o ano de forma que os anos fiquem de forma crescente e não decrescente como o original

 

 

Obrigado pela ajuda.

 

 

João Carlos

 

 

 

 

DFP.xls

adicionado 8 minutos depois

Só uma observação no item anterior : no exemplo que foi dado é de 2010 a 2012 ..... mas pode ser 2013 a 2015 , ou seja o ano é independente.

 

 

 

Obrigado