Ir ao conteúdo
  • Comunicados

    • Gabriel Torres

      Seja um moderador do Clube do Hardware!   12-02-2016

      Prezados membros do Clube do Hardware, Está aberto o processo de seleção de novos moderadores para diversos setores ou áreas do Clube do Hardware. Os requisitos são:   Pelo menos 500 posts e um ano de cadastro; Boa frequência de participação; Ser respeitoso, cordial e educado com os demais membros; Ter bom nível de português; Ter razoável conhecimento da área em que pretende atuar; Saber trabalhar em equipe (com os moderadores, coordenadores e administradores).   Os interessados deverão enviar uma mensagem privada para o usuário @Equipe Clube do Hardware com o título "Candidato a moderador". A mensagem deverá conter respostas às perguntas abaixo:   Qual o seu nome completo? Qual sua data de nascimento? Qual sua formação/profissão? Já atuou como moderador em algo outro fórum, se sim, qual? De forma sucinta, explique o porquê de querer ser moderador do fórum e conte-nos um pouco sobre você.   OBS: Não se trata de função remunerada. Todos que fazem parte do staff são voluntários.
    • DiF

      Poste seus códigos corretamente!   21-05-2016

      Prezados membros do Fórum do Clube do Hardware, O Fórum oferece um recurso chamado CODE, onde o ícone no painel do editor é  <>     O uso deste recurso é  imprescindível para uma melhor leitura, manter a organização, diferenciar de texto comum e principalmente evitar que os compiladores e IDEs acusem erro ao colar um código copiado daqui. Portanto convido-lhes para ler as instruções de como usar este recurso CODE neste tópico:  
Alexandre Botura

Consolidar várias planilhas em uma só

Recommended Posts

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

Compartilhar este post


Link para o post
Compartilhar em outros sites

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

 

Editado por Wendell Menezes
  • Obrigado 1

Compartilhar este post


Link para o post
Compartilhar em outros sites
  • Autor do tópico
  • 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?

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
    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.

    • Curtir 1

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • 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á.

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
    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

     

    • Obrigado 1

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    Crie uma conta ou entre para comentar

    Você precisar ser um membro para fazer um comentário






    Sobre o Clube do Hardware

    No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações 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

    ×