Guru do Excel e Power BI

Enviado: **03 Jan 2019 às 08:12**

Bom dia pessoal!

O assunto abaixo estou salvando de um outro tópico que seguiu outro caminho e eu não consegui implantar devido a complexidade do Query e a dificuldade dos usuários aqui no escritório. É um assunto um pouco extenso, mas estou mega disposto a esclarecer as dúvidas para tentar achar uma solução para esse caso.

--------------------

Assim como nos outros tópicos que criei anteriormente, meu sistema contábil gera relatórios em tamanho A4 para impressão, exporta para Excel (.csv) e eles na maioria das vez vêm com quebras de linha, linhas em branco, cabeçalhos das páginas e tudo isso tem que ser removido para que eu possa enviar ao meu cliente.

Vamos lá... dessa vez é um "Acompanhamento Mensal" com o resultado de várias unidades de uma empresa. Nessa caso são oito (02; 03; 04; 05; 06; 07; 09; 10).

Separei o arquivo Excel em várias planilhas separando cada passo a passo e aqui no tópico vou explicar o que eu faço para que fique mais fácil de entender.

Planilha "Original": É como o relatório sai do sistema... e o primeiro passo é remover as colunas brancas que estão entre as colunas B e X (destacado de vermelho).
** Importante: Esse relatório compreende 12 meses, de janeiro a dezembro, mas a quantidade de meses no relatório pode variar.

Planilha "Passo 1": Após removidas as colunas que estavam em branco, terei de separar as informações de cada unidade.
Cada relatório inicia com a linha "2648 RESULTADO LIQUIDO APOS IRPJ / CSLL". <- Essa será sempre a primeira linha da cada relatório, e eu destaquei a célula de verde para facilitar a visualização.
> Aqui entra o primeiro "problema", pois para identificar as unidades operacionais, seja "02 - Correia Pinto", "03 - Matriz" ou qualquer outra, essa informação vem na próxima quebra de página...
Por exemplo, o primeiro está na célula A14, e o centro de custo correspondente está na quebra de página, na célula A52.
Sempre o primeiro relatório já vem com Centro de Custo correto, mas os próximos sempre vem errado...

Nesse caso o que eu preciso é que seja inserido na linha superior de cada "2648 RESULTADO LIQUIDO APOS IRPJ / CSLL" o "Centro de Custo" que está na quebra de página abaixo. Ou seja, é só localizar o próximo Centro de Custo (que vem abaixo, não acima) e colar na linha superior do "2648 RESULTADO LIQUIDO APOS IRPJ / CSLL"

Eu não o porquê, mas o sistema traz o "Centro de Custo" no meio de cada relatório...
Eu coloquei Setas vermelhas na planilha mostrando a forma que tem que ser alterada...

E também remover as linhas em branco e essas que tem o "Centro de Custo" desnecessários (estão pintadas de um tom de laranja)

Planilha "Passo 2": Nessa planilha eu exemplifico como ficou organizado após transferir as linhas com os "Centros de Custo" acima de cada "2648 RESULTADO LIQUIDO APOS IRPJ / CSLL".

Planilha "Passo 3": Para que eu possa formatar essa planilha manualmente, eu insiro uma coluna de "total", onde ele soma cada linha, e filtro pelos que estão "0,00"... Mas Atenção! Existem linhas que possuem valores positivos e negativos que no "total" vão aparecer zeradas, e daí não podem ser removidas...
O Excel deve possuir um método que veja as linhas que possuam somente valores "0,00", e essas linhas devem ser removidas, como mostro nos passos 4, 5 e 6

Planilha "Passo 7": É o resultado final... como ficou o relatório após realocar os "Centros de Custo", remover as linhas e colunas sobressalentes e remover as linhas que possuam somente valores zerados.

Bônus: Seria muito bom e prático se também tivesse um jeito de fazer com que o Excel já separasse em planilhas o relatório de cada Centro de Custo...

Por Exemplo... 02 - Correia Pinto na Plan2; 03 - Matriz na Plan3 e assim por diante...

Eu sei que pela imensidão do texto parece coisa pra caramba, mas vejam pelo meu desespero em digitar tudo isso e ainda esperara a ajuda de alguém rsrs... perco muito tempo fazendo a formatação disso.

Conto com a ajuda de vocês... Muito obrigado!!

Enviado: **03 Jan 2019 às 13:25**

Luiz, veja se funciona. Me dê retorno.

Sub AcertaRel()

'Fase 1 - Apaga colunas e linhas, e acerta Centro de Custo
Range("C:C,E:E,G:G,I:I,K:K,M:M,O:O,Q:Q,S:S,U:U,W:W").Delete Shift:=xlToLeft
Ate = Cells(Rows.Count, "A").End(xlUp).Row
LinCC = 0 'Linha do Centro de Custo
Lin = 0
For Aux1 = 1 To Ate
Lin = Lin + 1
If Left(Trim(Cells(Lin + 1, "A").Value), 4) = "2648" Then LinCC = Lin
If Application.WorksheetFunction.CountA(Rows(Lin)) = 0 And Lin <> LinCC Then
Rows(Lin).Delete: GoTo Pula1
End If
If Left(Trim(Cells(Lin, "A").Value), 14) <> "Conta Contábil" And LinCC = 0 Then
Rows(Lin).Delete: GoTo Pula1
End If
If Left(Trim(Cells(Lin, "A").Value), 16) = "Centro de Custo:" And LinCC > 0 Then
Cells(LinCC, "A").Value = Cells(Lin, "A").Value
Rows(Lin).Delete: GoTo Pula1
End If
Lin = Lin + 1
Pula1:
Lin = Lin - 1
Next

'Fase 2 - Apaga linhas com total zero
Ate = Cells(Rows.Count, "A").End(xlUp).Row
Lin = 0
For Aux1 = 1 To Ate
Lin = Lin + 1
For Col = 2 To 13
If Cells(Lin, Col).Value = "" Or _
Abs(Cells(Lin, Col).Value) > 0 Then Exit For
Next
If Col > 13 Then Rows(Lin).Delete: Lin = Lin - 1
Next

'Fase 3 - Formata e põe total
Ate = Cells(Rows.Count, "A").End(xlUp).Row
Range("B2:N" & Ate).NumberFormat = "#,##0.00"
Range("B2:M" & Ate).ColumnWidth = 11
Range("N2:N" & Ate).ColumnWidth = 15
Range("N1").Value = "Totais"
Range("N3:N" & Ate).Value = "=Sum(B3:M3)"
Range("N1:N" & Ate).Interior.Color = 12632256

End Sub

Enviado: **03 Jan 2019 às 13:28**

Se funcionar ok com uma grande massa de dados, passamos para o bonus, de separar em planilhas.

Enviado: **03 Jan 2019 às 13:32**

Boa tarde Jimmy, simplesmente perfeito!! Vou conferir a fundo se nenhuma linha foi excluída e se meu relatório ainda está compatível com essa Macro. Dou retorno em seguida!

Enviado: **03 Jan 2019 às 14:02**

Jimmy,

Estou anexando o relatório que acabei de exportar do sistema (plan1). Executei a macro nele e as datas lá na linha superior desapareceram. Aparentemente ele é igual ao outro que anexei anteriormente, não sei o que pode ter acontecido.

Outro detalhe que esqueci de mencionar...

Esse relatório vai aumentando durante o ano. Por exemplo:
Em janeiro de 2019 o relatório sai somente jan/2019,
Em fevereiro de 2019 o relatório sai jan/2019 e fev/2019
Em março de 2019 o relatório sai jan/2019 até mar/2019
...
E em dezembro de 2019 o relatório sai jan/2019 até dez/2019.

Executei aqui com apenas um mês e não deu certo =/ Também está anexo (plan2)

Enviado: **03 Jan 2019 às 18:39**

@Luiz,

Para decidir quais linhas devem ser apagadas, e quais não, foi necessário estabelecer critérios, que estabeleci com base no relatório inicialmente enviado por você.

Como aquelas linhas iniciais todas devem ser deletadas, exceto a de datas, adotei como critério o texto "Conta Contábil": se houver esse texto na coluna A, não apago a linha, caso contrário, paredão pra ela. Eu imaginei que esse texto era imutável, uma vez que o relatório era gerado por um sistema.

Ocorre que neste segundo teste que você fez, na linha de datas aparece o texto "Conta contbil", faltando um Á acentuado. Dessa forma, a linha foi pro paredão. Verá que se alterar esse texto e testar novamente, vai rodar bem.

Para sanar isso podemos adotar outro critério, mas ai conto com sua ajuda para defini-lo.

Obs.: O texto "Centro de Custo:" também é importante para a execução da macro. Se ele mudar, não vai rodar bem.

Quanto aos meses poderem variar de 1 a 12, não vejo problema nisso, uma vez que as colunas de meses são as últimas, não havendo nada após elas. O único detalhe é que a coluna de totais será sempre colocada na N. Se isso for problema, podemos ler a linha de cabeçalho dos meses para definir quantos são, e com base nisso definir o local da coluna de totais.

Enviado: **04 Jan 2019 às 14:05**

Jimmy,

Obrigado pela ajuda! Era apenas isso mesmo. Colocando o "á" na planilha ou ajustando para "contabil" na macro o problema é resolvido.

Não há problema em a coluna do total aparecer na coluna N.

Com isso resolvido, você acha que é possível fazer com que cada unidade seja separada em uma planilha?

Obrigado!

Enviado: **04 Jan 2019 às 20:26**

Sim, vamos separar em planilhas. Amanhã tentarei trabalhar nisso.

Me tire uma dúvida. Porque o software que gera o relatório bruto gerou uma palavra faltando um "á"? Isso pode ser preocupante pois há outros textos que supomos serem fixos, mas podem não ser. Se forem sistemas diferentes que geram o mesmo relatório, e há pequenas diferenças entre eles, podemos usar o comparador lógico OU e aceitar OU um OU outro.

A questão da coluna N é bem fácil de resolver. Não devemos mexer nisso APENAS se você julgar que é melhor que fique na N por uma questão de padronização, etc. Caso contrário colamos ela após o último mês.

Enviado: **07 Jan 2019 às 07:24**

Bom dia Jimmy,

Vamos lá... O Fato de estar aparecendo "Conta Contbil" (sem o á) se deve ao fato de alguma atualização que algum orelha seca mexeu no relatório e estragou essa palavra, daí quando atualizou o sistema veio assim...

As vezes temos relatórios personalizados que quando são editados podem passar por alguma alteração (positiva ou negativa). Que inclusive é o que eu vou fazer... duplicar o layout do atual e salvar para caso atualizem esse sistema o novo layout não fazer com que seja necessário uma nova macro

)

Existem também relatórios em que é possível "parametrizar" esses cabeçalhos e títulos antes da impressão do relatório, o que não é o caso... Aqui foi cabeçada do sistema na última vez que atualizaram o sistema... Inclusive vou entrar em contato com sistema para resolver isso...

Sobre o total da coluna N.... Se for possível que apareça o total na coluna seguinte ao ultimo mês apresentado, excelente (se não ser muito trabalho também), senão deixamos como está =D

Valeu Jimmy, boa semana!

Enviado: **07 Jan 2019 às 10:13**

Bom dia Luiz,

Concluí a divisão dos Centros de Custo. A macro ficou um pouco grande, mas acredito que esteja correta. Gostaria que você testasse com uma massa de dados grande.

Alterei algumas coisas também na geração do relatório (coluna de totais colado na coluna da última data), portanto, a macro abaixo segue completa, para substituir toda a macro que você já tem.

Como antes, execute a macro estando com a planilha do relatório bruto selecionada, pois a macro se baseia na planilha ativa.

As planilhas de Centro de Custo foram criadas com apenas uma parte do nome. Se você quiser diferente do que eu fiz, avise. Elas tem o nome iniciando por #, porque a macro, antes de gerar as planilhas, apaga eventuais antigas que tenham ficado. Para isso usa como critério apagar TODAS as planilhas que iniciem por #. Dá pra mudar esse caracter também. Ele está definicio na primeira linha da macro

Sempre há a possibilidade de uma falha ocorrer, e um valor errado ser passado pra frente. Para minimizar isso criei uma planilha chamada #Resumo que mostra a soma dos valores de cada Centro de Custo, a soma dos valores da planilha principal, e a diferença entre elas. Se houver diferença maior do que 0,0001 haverá aviso em vermelho na planilha #Resumo. Após geradas as planilhas, vá em uma delas, acrescente 1 centavo em algum valor, e veja como ficou a #Resumo. Acho que assim ficará mais difícil um erro passar.

Código: Selecionar todos

Sub AcertaRel()
    Char = "#"

   'Fase 1 - Apaga colunas e linhas, e acerta Centro de Custo
    Range("C:C,E:E,G:G,I:I,K:K,M:M,O:O,Q:Q,S:S,U:U,W:W").Delete Shift:=xlToLeft
    Ate = Cells(Rows.Count, "A").End(xlUp).Row
    LinCC = 0 'Linha do Centro de Custo
    Lin = 0
    For Aux1 = 1 To Ate
        Lin = Lin + 1
        If Left(Trim(Cells(Lin + 1, "A").Value), 4) = "2648" Then LinCC = Lin
        If Application.WorksheetFunction.CountA(Rows(Lin)) = 0 And Lin <> LinCC Then
            Rows(Lin).Delete: GoTo Pula1
        End If
        If LinCC = 0 Then     'Ainda estamos no cabeçalho
            If Left(Trim(Cells(Lin, "A").Value), 14) = "Conta Contábil" Then  'Achou linha de datas
                MaxDatCol = Cells(Lin, Columns.Count).End(xlToLeft).Column    'Última coluna de data
            Else
                Rows(Lin).Delete: GoTo Pula1
            End If
        End If
        If Left(Trim(Cells(Lin, "A").Value), 16) = "Centro de Custo:" And LinCC > 0 Then
            Cells(LinCC, "A").Value = Cells(Lin, "A").Value
            Rows(Lin).Delete: GoTo Pula1
        End If
        Lin = Lin + 1
Pula1:
        Lin = Lin - 1
    Next
    
   'Fase 2 - Apaga linhas com total zero
    Ate = Cells(Rows.Count, "A").End(xlUp).Row
    Lin = 0
    For Aux1 = 1 To Ate
        Lin = Lin + 1
        For Col = 2 To 13
            If Cells(Lin, Col).Value = "" Or _
            Abs(Cells(Lin, Col).Value) > 0 Then Exit For
        Next
        If Col > 13 Then Rows(Lin).Delete: Lin = Lin - 1
    Next
    
   'Fase 3 - Formata e põe total
    MaxTotCol = MaxDatCol + 1
    Ate = Cells(Rows.Count, "A").End(xlUp).Row
    Range(Cells(2, "B"), Cells(Ate, MaxTotCol)).NumberFormat = "#,##0.00"
    Range(Cells(1, "B"), Cells(1, MaxDatCol)).ColumnWidth = 11
    Cells(1, MaxTotCol).ColumnWidth = 15
    Cells(1, MaxTotCol).Value = "Totais"
    Cells(1, MaxTotCol).HorizontalAlignment = xlRight
    Range(Cells(3, MaxTotCol), Cells(Ate, MaxTotCol)).Value = "=Sum(B3:" & Mid(Columns(MaxDatCol).Address, 2, 1) & "3)"
    Range(Cells(1, MaxTotCol), Cells(Ate, MaxTotCol)).Interior.Color = 12632256

   'Fase 4 - Cria planilhas para Centros de Custo
    Aux1 = Application.DisplayAlerts: Application.DisplayAlerts = False
    For Each Plan In Worksheets 'Percorre as planilhas apagando as de gerações passadas
        If Left(Plan.Name, 1) = Char Then Plan.Delete
    Next
    Application.DisplayAlerts = Aux1
    Set Base = ActiveSheet
    Set Nova = ActiveSheet
    Ate = Cells(Rows.Count, "A").End(xlUp).Row
    LinIni = 0:  CenCus = ""
    For Lin = 1 To Ate + 1
        Texto = WorksheetFunction.Trim(Cells(Lin, "A").Value)
        If Left(Texto, 16) = "Centro de Custo:" Or Lin = Ate + 1 Then
            If LinIni <> 0 Then
                LinFim = Lin - 1
                Sheets.Add                       'Inclui nova planilha
                ActiveSheet.Name = CenCus        'Renomeia
                ActiveSheet.Move After:=Nova     'Posiciona
                Set Nova = ActiveSheet
                Base.Select:   Range(Cells(1, "A"), Cells(1, MaxTotCol)).Copy             'Copia cabeçalho
                Nova.Select:   Cells(1, 1).Select:  ActiveSheet.Paste
                Base.Select:   Range(Cells(LinIni, "A"), Cells(LinFim, MaxTotCol)).Copy   'Copia conteúdo
                Nova.Select:   Cells(2, 1).Select:  ActiveSheet.Paste
                Base.Select:   Range(Columns(1), Columns(MaxTotCol)).Copy                 'Copia formatação
                Nova.Select:   Range(Columns(1), Columns(MaxTotCol)).PasteSpecial Paste:=xlPasteFormats
                Cells(1, 1).Select
                Base.Select:   Cells(1, 1).Select:   Application.CutCopyMode = False
            End If
            LinIni = Lin
            CenCus = Char & Trim(Mid(Texto, InStr(1, Texto, "-") + 1, 15))
        End If
    Next
    
   'Fase 5 - Cria planilhas de Resumo
    Sheets.Add                       'Inclui planilha RESUMO
    Set Nova = ActiveSheet
    Nova.Move After:=Base            'Posiciona após a planilha total
    Cells(1, "A") = "R E S U M O"
    Lin = 4
    Cells(Lin, "A").Select: Selection.Font.Bold = True:  Selection.Value = "CENTROS DE CUSTO"
    For Each Plan In Worksheets      'Percorre as planilhas jogando na planilha Resumo
        If Left(Plan.Name, 1) = Char Then
            Lin = Lin + 1
            Nova.Cells(Lin, "A") = Mid(Plan.Cells(2, 1), 18)
            Nova.Cells(Lin, "B") = "=Sum('" & Plan.Name & "'!" & Columns(MaxTotCol).Address & ")"
        End If
    Next
    Lin = Lin + 2:   Nova.Cells(Lin, "A") = "SOMA"
                     Nova.Cells(Lin, "B") = "=Sum(B3:B" & Lin - 1 & ")"
    Lin = Lin + 1:   Nova.Cells(Lin, "A") = "SOMA na planilha """ & Base.Name & """"
                     Nova.Cells(Lin, "B") = "=Sum('" & Base.Name & "'!" & Columns(MaxTotCol).Address & ")"
    Lin = Lin + 2:   Nova.Cells(Lin, "A") = "Diferença"
                     Nova.Cells(Lin, "B") = "=round(B" & Lin - 3 & " - B" & Lin - 2 & ",4)"
    Range(Cells(Lin, "A"), Cells(Lin, "B")).Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=ABS($B$" & Lin & ")>=0,0001"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).Font.Bold = True
    Selection.FormatConditions(1).Interior.Color = 255
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B2:N" & Lin - 1).NumberFormat = "#,##0.00"
    Nova.Columns("A:B").EntireColumn.AutoFit
    Cells(1, 1).Select
    Nova.Name = Char & "Resumo":   Nova.Select:   Cells(1, 1).Select
    
    Set Base = Nothing
    Set Nova = Nothing

End Sub

Qualquer problema, avise.

Jimmy San Juan

Enviado: **07 Jan 2019 às 13:49**

Boa tarde Jimmy,

http://prntscr.com/m4410c

Esse é o erro que obtive. Inseri um novo módulo e colei o código que você me passou (Desde Sub até End Sub)

Enviado: **07 Jan 2019 às 14:10**

Anexe a planilha já com o módulo inserido e como fez para executar.

Na figura que vc mandou vejo o erro, mas não sei a que linha de código se aplica.

Enviado: **07 Jan 2019 às 15:30**

Jimmy,

Desculpe a ignorância, mas não sei se fiz da forma correta para salvar aqui e te mandar...

Abri a planilha, inseri o módulo, colei o código, executei e salvei tudo como XLSM.

Se não for dessa forma, por favor, solicito que tenha mais um balde de paciência (mais do que tem tido até agora) e me explique a forma correta, rsrs

Abraços!

Enviado: **07 Jan 2019 às 16:17**

Luiz, não é necessário se desculpar. Eu também não sei uma tonelada de coisas. Todos estamos aprendendo.

Vou te pedir que anexe a planilha novamente, mas antes de executá-la. Preciso dos dados do relatório bruto para poder acompanhar a execução e ver onde está o problema. Salve-a no ponto em que só falta executar, e me mande.

Enviado: **08 Jan 2019 às 07:18**

Bom dia!

Opss, não ajudei né rsrs

Segue o relatório da forma como sai do sistema, pronto para executar a macro

Enviado: **08 Jan 2019 às 12:28**

Luiz,

O problema desta vez é o mesmo de antes: na primeira célula da linha cabeçalho de meses está escrito "Conta Contbil", sem o "á".

Antes o problema que isso causava era apenas apagar a linha de meses.

Como alterei a macro para verificar qual o último mês, e colocar a coluna de totais na próxima coluna livre, a falta do texto "Conta Contábil" impede a macro de determinar onde será a coluna de totais, o que gerou o erro.

Alterei novamente a macro: quando ela não conseguir achar a linha cabeçalho de meses, irá emitir um aviso, e definir a coluna de totais como sendo a "N", como era antes. Assim ela não para a execução, mas avisa.

Por via das dúvidas, vou passar a "olhar" apenas para o início do texto: "Conta Cont", assim funcionará mesmo que falte o "á", e creio que não corremos o risco de achar outra linha (sem ser a de datas).

Código: Selecionar todos

Sub AcertaRel()
    Char = "#"

   'Fase 1 - Apaga colunas e linhas, e acerta Centro de Custo
    Range("C:C,E:E,G:G,I:I,K:K,M:M,O:O,Q:Q,S:S,U:U,W:W").Delete Shift:=xlToLeft
    Ate = Cells(Rows.Count, "A").End(xlUp).Row
    LinCC = 0 'Linha do Centro de Custo
    Lin = 0
    For Aux1 = 1 To Ate
        Lin = Lin + 1
        If Left(Trim(Cells(Lin + 1, "A").Value), 4) = "2648" Then LinCC = Lin
        If Application.WorksheetFunction.CountA(Rows(Lin)) = 0 And Lin <> LinCC Then
            Rows(Lin).Delete: GoTo Pula1
        End If
        If LinCC = 0 Then     'Ainda estamos no cabeçalho
            If Left(Trim(Cells(Lin, "A").Value), 10) = "Conta Cont" Then    'Achou linha de datas
                MaxDatCol = Cells(Lin, Columns.Count).End(xlToLeft).Column  'Última coluna de data
            Else
                Rows(Lin).Delete: GoTo Pula1
            End If
        End If
        If Left(Trim(Cells(Lin, "A").Value), 16) = "Centro de Custo:" And LinCC > 0 Then
            Cells(LinCC, "A").Value = Cells(Lin, "A").Value
            Rows(Lin).Delete: GoTo Pula1
        End If
        Lin = Lin + 1
Pula1:
        Lin = Lin - 1
    Next
    
   'Fase 2 - Apaga linhas com total zero
    Ate = Cells(Rows.Count, "A").End(xlUp).Row
    Lin = 0
    For Aux1 = 1 To Ate
        Lin = Lin + 1
        For Col = 2 To 13
            If Cells(Lin, Col).Value = "" Or _
            Abs(Cells(Lin, Col).Value) > 0 Then Exit For
        Next
        If Col > 13 Then Rows(Lin).Delete: Lin = Lin - 1
    Next
    
   'Fase 3 - Formata e põe total
    If MaxDatCol = 0 Then
       MaxDatCol = 13
       MsgBox "A linha de cabeçalho de meses não foi definida pois " & _
              "o texto ""Conta Cont"" não foi encontrado na coluna ""A""." & vbCrLf & vbCrLf & _
              "A coluna de totais será faita na coluna ""N""."
    End If
    MaxTotCol = MaxDatCol + 1
    Ate = Cells(Rows.Count, "A").End(xlUp).Row
    Range(Cells(2, "B"), Cells(Ate, MaxTotCol)).NumberFormat = "#,##0.00"
    Range(Cells(1, "B"), Cells(1, MaxDatCol)).ColumnWidth = 11
    Cells(1, MaxTotCol).ColumnWidth = 15
    Cells(1, MaxTotCol).Value = "Totais"
    Cells(1, MaxTotCol).HorizontalAlignment = xlRight
    Range(Cells(3, MaxTotCol), Cells(Ate, MaxTotCol)).Value = "=Sum(B3:" & Mid(Columns(MaxDatCol).Address, 2, 1) & "3)"
    Range(Cells(1, MaxTotCol), Cells(Ate, MaxTotCol)).Interior.Color = 12632256

   'Fase 4 - Cria planilhas para Centros de Custo
    Aux1 = Application.DisplayAlerts: Application.DisplayAlerts = False
    For Each Plan In Worksheets 'Percorre as planilhas apagando as de gerações passadas
        If Left(Plan.Name, 1) = Char Then Plan.Delete
    Next
    Application.DisplayAlerts = Aux1
    Set Base = ActiveSheet
    Set Nova = ActiveSheet
    Ate = Cells(Rows.Count, "A").End(xlUp).Row
    LinIni = 0:  CenCus = ""
    For Lin = 1 To Ate + 1
        Texto = WorksheetFunction.Trim(Cells(Lin, "A").Value)
        If Left(Texto, 16) = "Centro de Custo:" Or Lin = Ate + 1 Then
            If LinIni <> 0 Then
                LinFim = Lin - 1
                Sheets.Add                       'Inclui nova planilha
                ActiveSheet.Name = CenCus        'Renomeia
                ActiveSheet.Move After:=Nova     'Posiciona
                Set Nova = ActiveSheet
                Base.Select:   Range(Cells(1, "A"), Cells(1, MaxTotCol)).Copy             'Copia cabeçalho
                Nova.Select:   Cells(1, 1).Select:  ActiveSheet.Paste
                Base.Select:   Range(Cells(LinIni, "A"), Cells(LinFim, MaxTotCol)).Copy   'Copia conteúdo
                Nova.Select:   Cells(2, 1).Select:  ActiveSheet.Paste
                Base.Select:   Range(Columns(1), Columns(MaxTotCol)).Copy                 'Copia formatação
                Nova.Select:   Range(Columns(1), Columns(MaxTotCol)).PasteSpecial Paste:=xlPasteFormats
                Cells(1, 1).Select
                Base.Select:   Cells(1, 1).Select:   Application.CutCopyMode = False
            End If
            LinIni = Lin
            CenCus = Char & Trim(Mid(Texto, InStr(1, Texto, "-") + 1, 15))
        End If
    Next
    
   'Fase 5 - Cria planilhas de Resumo
    Sheets.Add                       'Inclui planilha RESUMO
    Set Nova = ActiveSheet
    Nova.Move After:=Base            'Posiciona após a planilha total
    Cells(1, "A") = "R E S U M O"
    Lin = 4
    Cells(Lin, "A").Select: Selection.Font.Bold = True:  Selection.Value = "CENTROS DE CUSTO"
    For Each Plan In Worksheets      'Percorre as planilhas jogando na planilha Resumo
        If Left(Plan.Name, 1) = Char Then
            Lin = Lin + 1
            Nova.Cells(Lin, "A") = Mid(Plan.Cells(2, 1), 18)
            Nova.Cells(Lin, "B") = "=Sum('" & Plan.Name & "'!" & Columns(MaxTotCol).Address & ")"
        End If
    Next
    Lin = Lin + 2:   Nova.Cells(Lin, "A") = "SOMA"
                     Nova.Cells(Lin, "B") = "=Sum(B3:B" & Lin - 1 & ")"
    Lin = Lin + 1:   Nova.Cells(Lin, "A") = "SOMA na planilha """ & Base.Name & """"
                     Nova.Cells(Lin, "B") = "=Sum('" & Base.Name & "'!" & Columns(MaxTotCol).Address & ")"
    Lin = Lin + 2:   Nova.Cells(Lin, "A") = "Diferença"
                     Nova.Cells(Lin, "B") = "=round(B" & Lin - 3 & " - B" & Lin - 2 & ",4)"
    Range(Cells(Lin, "A"), Cells(Lin, "B")).Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=ABS($B$" & Lin & ")>=0,0001"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).Font.Bold = True
    Selection.FormatConditions(1).Interior.Color = 255
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B2:N" & Lin - 1).NumberFormat = "#,##0.00"
    Nova.Columns("A:B").EntireColumn.AutoFit
    Cells(1, 1).Select
    Nova.Name = Char & "Resumo":   Nova.Select:   Cells(1, 1).Select
    
    Set Base = Nothing
    Set Nova = Nothing

End Sub

Enviado: **08 Jan 2019 às 13:43**

Jimmy,

Perfeito! Fazer a buscar por "Conta Cont" resolve tudo! Claro que foi vacilo meu não atentar para esse detalhe, mas agora a macro aceita das duas formas...

Novamente, muito obrigado!

Resolvido.

Guru do Excel e Power BI

Formatar Relatórios e Separar em Planilhas

Formatar Relatórios e Separar em Planilhas

Formatar Relatórios e Separar em Planilhas

Formatar Relatórios e Separar em Planilhas

Formatar Relatórios e Separar em Planilhas

Re: Formatar Relatórios e Separar em Planilhas

Re: Formatar Relatórios e Separar em Planilhas

Re: Formatar Relatórios e Separar em Planilhas

Formatar Relatórios e Separar em Planilhas

Re: Formatar Relatórios e Separar em Planilhas

Re: Formatar Relatórios e Separar em Planilhas

Re: Formatar Relatórios e Separar em Planilhas

Formatar Relatórios e Separar em Planilhas

Re: Formatar Relatórios e Separar em Planilhas

Formatar Relatórios e Separar em Planilhas

Re: Formatar Relatórios e Separar em Planilhas

Re: Formatar Relatórios e Separar em Planilhas

Re: Formatar Relatórios e Separar em Planilhas