segunda-feira, 10 de dezembro de 2012

Macro para Preencher Lacunas e Colar Valores/Fórmulas

Boa noite!!

Segue outra macro básica que pode ajudar no dia-a-dia.

Diversas vezes utilizei uma Tabela Dinâmica para resumir dados de grandes tabelas de maneira prática e rápida. Após reorganizar os dados conforme desejado na Tabela Dinâmica, basta copiar a colar valores na aba e teremos uma nova tabela mais resumida.

Entretanto, este método pode gerar tabelas com lacunas por conta da função de resumir, como no caso da tabela abaixo:



No caso de precisarmos utilizar alguma chave nesta nova tabela ou mesmo criar outra Tabela Dinâmica a partir dela, teremos de preencher manualmente os espaços vazios. Há métodos para se fazer isso, que demandariam algum trabalho, mas neste caso vamos usar a seguinte macro para auxiliar no preenchimento:


Sub Preenche()

'
' Macro para preencher as linhas em branco entre linhas preenchidas,
' copiando o valor das células preenchidas imediatamente acima.
' Selecionar a área a ser preenchida e executar a macro.
'
    Dim rng As Range, str As String
    
    Set rng = ActiveSheet.Range(Selection.Address(False, False)) 'Coleta o "Range" selecionado

    On Error Resume Next 'Ignora possíveis erros
    For k = 1 To rng.Areas.Count 'Percorre todas as áreas selecionadas
        For i = 1 To rng.Areas(k).Columns.Count
            str = ""
            For j = 1 To rng.Areas(k).Rows.Count
                
                '"Varre" verticalmente cada célula das áreas
                'selecionadas, e verifica o conteúdo. Se for diferente
                'de vazio, armazena o conteúdo na variável "str" e preenche
                'as células vazias posteriores com o conteúdo desta variável.
                'O conteúdo de "str" é sobrescrito a cada vez que uma célula
                'com conteúdo diferente de vazio é encontrada.
                
                If rng.Areas(k).Cells(j, i).Value <> "" Then
                    str = rng.Areas(k).Cells(j, i).Value
                Else
                    rng.Areas(k).Cells(j, i).Value = str
                End If

            Next
        Next
    Next

End Sub

Agora, selecionando a tabela conforme a figura abaixo:


E aplicando a macro, teremos a tabela preenchida conforme a figura que segue:


E o preenchimento está pronto!

Colando Valores e/ou Fórmulas

Falando em copiar e colar valores, fiz uma macro para colar valores e uma para colar fórmulas que têm sido de grande utilidade. Configurei os atalhos como Ctrl + Shift + V (colar valores) e Ctrl + F (colar fórmulas). Assim fica bem mais rápido colar os valores e/ou fórmulas quando desejado. As macros são bem simples, conforme abaixo:


Sub Colar_Valores()
'
' Cola valores
'
    On Error Resume Next
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub


Sub Colar_Fórmulas()
'
' Cola Fórmulas
'
    On Error Resume Next
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End Sub


Bom, chega ao fim mais um post. Espero que seja útil, leitor!
Dúvidas e/ou sugestões, escrevam para: guiamacroexcel@gmail.com.

Obrigado e até a próxima!

quarta-feira, 14 de novembro de 2012

Macro Para Exportar Planilha

Boa noite, pessoal!

Segue uma macro simples que tenho usado no dia-a-dia.

O código serve para exportar a aba que está ativa para um novo arquivo do Excel.
Primeiramente é criada uma cópia da aba selecionada e, depois, são copiados e colados valores nesta nova aba. Por último, esta aba replicada com valores é exportada.
O arquivo sai pronto para ser enviado por e-mail, por exemplo, sem risco de enviar arquivos com vínculos que podem impedir ou dificultar seu uso em outra máquina.


Sub Exportar()

    Application.DisplayAlerts = False 'Desabilita alertas
        
    ActiveSheet.Copy After:=Worksheets(Worksheets.Count) 'Cria cópia da aba selecionada
        
    Cells.Select 'Seleciona todas as células da nova aba
    Selection.Copy 'Copia conteúdo
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'Cola valores
    Application.CutCopyMode = False 'Desabilita modo de cópia

    ActiveWindow.SelectedSheets.Move 'Exporta aba selecionada para novo arquivo

    Application.DisplayAlerts = True 'Reabilita alertas

End Sub


Bom, é isso. Espero que gostem.

Para dúvidas e/ou sugestões, por favor, escrevam para guiamacroexcel@gmail.com.

Até a próxima!

terça-feira, 23 de outubro de 2012

Função para Auxiliar Consultas no Access

Pessoal,

Segue função que fiz para auxiliar a criação de consultas no Access com critérios do tipo "[Variável] Ou [Variável] Ou [Variável] Ou ...". Antes, quando eu tinha um conjunto de variáveis a serem filtradas em uma consulta, era necessário executar um procedimento manual para preenchimento dos "Ou"s entre as variáveis. Usando a fórmula, o trabalho fica menor e muito mais rápido. Segue o código:


Function Consulta(ByVal Space As Range)

'
'
'   Função para gerar uma chave com conteúdos das células separados por " Ou ",
' para usá-las em consultas no Access.


    Dim rng As Range, str As String
    
    str = ""
    
    On Error Resume Next
    For Each rng In Space.Areas
        For Each cell In rng
            str = str & cell.Value & " Ou "
        Next
    Next
    
    Consulta = Left(str, Len(str) - 4)
    
End Function

Durante o uso da função, cabe uma observação: Para seleções múltiplas (mais de uma área - segurando Ctrl durante a seleção), usar um parêntesis adicional, indicando que todas as áreas devem ser associadas

à uma única variável do tipo "Range", acessada através de rng.Areas(n), onde n é o índice da área. Por exemplo: =Consulta(Área) ou =Consulta((Múltiplas_Áreas)). Seguem imagens ilustrativas dos dois casos, com uma única área e múltiplas áreas, respectivamente:




O código também serve como base para a criação de outras funções para gerar chaves de consulta automaticamente, por exemplo do tipo "<> [Variável] E <> [Variável] E <> [Variável] E <> ...".

Bom, é isso. Espero que tenham gostado.

Para dúvidas e/ou sugestões, por favor, escrevam!

Até a próxima!


sábado, 22 de setembro de 2012

Criando e Instalando Suplementos

Boa noite, pessoal.

Hoje vamos abordar a criação e instalação de suplementos no Excel.
A instalação de suplementos é uma excelente alternativa para integração de recursos ao Excel de maneira simples e transparente. O suplemente pode ser ativado/desativado ou mesmo trocado/atualizado conforme a necessidade, com alguns poucos cliques. Vamos à um exemplo!

1) Criando o Arquivo Base

O primeiro passo é criar um arquivo contendo as funções que irão integrar o suplemento.
Vamos criar um suplemento com a função "Chave()", exibida no último post. Para tal, vamos abrir uma nova planilha do Excel, e pressionar 'Alt + F11' para abrir o editor. Conforme o post com o Básico de Macros, criamos então uma macro com código da função reescrita abaixo:

Function Chave(ByVal Space As Range)
'
'
' Função para gerar uma chave com conteúdos das células separados por "-"
' Para seleções múltiplas (mais de uma área - segurando Ctrl durante a seleção),
' usar um parêntesis adicional, indicando que todas as áreas devem ser associadas
' à uma única varíavel range, acessada através de rng.Areas(n), onde n é o
' índice da área. Ex.:
' =Chave(Área) ou =Chave((Múltiplas_Áreas))
'
'
'

    Dim rng As Range, str As String
   
    str = ""
      
    For Each rng In Space.Areas
        For Each cell In rng
            str = str & cell.Value & "-"
        Next
    Next
   
    Chave = Left(str, Len(str) - 1)
   
End Function

Teste a função na planilha, para se certificar de que a mesma está funcionando corretamente. Então, limpe o conteúdo de todas as planilhas do documento (para que o arquivo ocupe o menor espaço possível). Pode-se, inclusive, manter apenas uma das planilhas, excluindo as demais.

Vamos então salvar o arquivo como um arquivo de suplemento. Vá até o menu principal e clique em "Salvar Como". Na tela que se abre, troque o "Tipo" do arquivo para "Suplemento do Excel (.xlam)". Neste momento, o Excel deve imediatamente abrir a pasta-padrão dos suplementos instalados (caso o seu Excel não abra automaticamente este diretório, salve o arquivo em qualquer local de fácil acesso para remanejá-lo mais tarde). Salve o arquivo nesta pasta e feche o Excel. Qualquer nome pode ser usado para o arquivo.

2) Instalando o Suplemento


Vamos abrir uma nova planilha e clicar no menu principal. Clique em "Opções". A tela abaixo irá se abrir:


No menu presente na lateral esquerda, clicar em "Suplementos" para visualizar os suplementos instalados e ativos. Você verá a tela abaixo:


Na parte inferior, clicar em "Ir...". A janela abaixo irá se abrir, com os suplementos instalados que podem ser habilitados/desabilitados marcando/desmarcando cada item:


Nesta tela, clique em "Procurar...". A janela abaixo irá se abrir, apontando para o diretório-padrão dos suplementos:


Caso você tenha salvado o arquivo nesta pasta, basta abri-lo. Caso esteja em outro local, pode-se buscá-lo onde ele estiver (o mais prático é colar o arquivo salvo em outro local neste diretório que se abre, por ser o diretório-padrão). Após abrir o arquivo e retornar à janela anterior, seu nome deve aparecer na lista. Basta então marcá-lo na lista para ativá-lo e, a partir de então, suas funções estarão integradas ao Excel instalado na máquina. Clicar em "OK" para retornar à planilha.

Finalizado o procedimento, pode-se testar a função "Chave()" na própria planilha, ou em qualquer outra aberta após a instalação.

Existem outro métodos para integração de macros/funções no Excel, como por exemplo através da edição da Pasta Pessoal de Macros. Entretanto, este método não é bem transparente, uma vez que é necessário habilitar as macros a cada nova execução do Excel, ou desabilitar a proteção contra macros nas opções do Excel (o que não seria uma boa opção).

Até agora, a integração dos suplementos com o Excel me foi 100% transparente, sempre!

Bom, por hoje é só. Espero que tenham gostado!

Até a próxima!

terça-feira, 18 de setembro de 2012

A Função Somase

Boa noite, leitor.

Hoje, vamos mostrar como usar uma das funções-padrão do Excel, que com certeza é muito útil.
Ao final, apresento uma função que criei a fim de tornar uma de suas aplicações mais práticas e eficientes.

1) A função Somase

Para aqueles que não conhecem, a função Somase permite ao usuário realizar a soma de um conjunto de valores tomando por base o uso de uma chave de referência. Numa tabela, podemos usar uma coluna com nomes para buscar valores e então realizar a soma dos valores que corresponderem positivamente à chave.

O formato da função é o que segue:

=Somase(Intervalo_de_Referência, Chave, Intervalo_de_Soma)

Onde:
Intervalo_de_Referência = Intervalo onde devem ser buscadas as chaves;
Chave = É a chave a ser comparada com os itens indicados na primeira área;
Intervalo_de_Soma = Intervalo contendo os valores a serem somados caso o item seja igual à chave.

Vamos à um exemplo. Segue abaixo uma tabela com valores e várias chaves de identificação para custos unitários:


Suponha que desejamos saber o total do custo unitário em cada mês. Podemos usar a função Somase(Intervalo_Mês, Mês_Desejado, Valores_Somados), da seguinte forma:


Perceba que o total está consistido, não houve perda de informação. Podemos fazer o mesmo para encontrar o total por Produto ou por Comprador, conforme imagens abaixo:



Mas e se quiséssemos encontrar uma combinação específica, como o total gasto pelo Marcelo na compra de Arroz, em todos os meses? Ou quanto o Luiz gastou em Feijão no período? Podemos fazer uma chave de busca para encontrar os valores desejados, conforme abaixo:


Usando a chave de busca, podemos encontrar o que desejamos, remontando a chave dentro da função Somase:



2) Casos específicos com o Somase

Em alguns casos, o uso de chaves de busca pode gerar alguns inconvenientes. Segue novo exemplo de tabela com dois códigos de referência genéricos:


Da mesma forma que no exemplo anterior, podemos calcular o total de um único código fazendo uso direto da função Somase:


Mas e no caso de montarmos chaves? Uma vez que estamos usando estes novos códigos, algo curioso pode acontecer:


Perceba que a combinação dos códigos gerou algumas chaves iguais mesmo com componentes diferentes. Isto irá afetar o resultado quando queremos a soma das combinações, retornando resultados iguais para as chaves que deveriam ser distintas:


Podemos resolver este problema utilizando um separador entre os códigos, por exemplo um "-". Assim, não teremos problemas com a ambiguidade das palavras (chaves) formadas:


Basta, agora, adicionar os separadores às chaves dentro da função Somase:



3) A função "Chave"


Muito embora seja razoável incluir um separador entre os itens de uma chave, o trabalho de adicionar manualmente um "-" entre as strings pode ser bastante maçante caso repetido várias vezes. Além disso, perde-se muito tempo. Criei então a função abaixo para ganhar eficiência e uniformizar o trabalho de criar chaves de busca:

Function Chave(ByVal Space As Range)


'
'
' Função para gerar uma chave com conteúdos das células separados por "-"
' Para seleções múltiplas (mais de uma área - segurando Ctrl durante a seleção),
' usar um parêntesis adicional, indicando que todas as áreas devem ser associadas
' à uma única varíavel range, acessada através de rng.Areas(n), onde n é o
' índice da área. Ex.:
' =Chave(Área) ou =Chave((Múltiplas_Áreas))
'
'
'

    Dim rng As Range, str As String
   
    str = ""
      
    For Each rng In Space.Areas
        For Each cell In rng
            str = str & cell.Value & "-"
        Next
    Next
   
    Chave = Left(str, Len(str) - 1)
   
End Function

O trabalho de criar as chaves com o separador incluído fica então muito mais rápido, fazendo:


Pode-se usá-la até mesmo dentro da função Somase, para gerar a chave de referência:


Esta função possui apenas uma particularidade: No caso de usarmos como parâmetro uma área com mais de uma área de seleção não contíguas (por exemplo, segurando Ctrl e clicando em várias células), deve-se usar um par de parênteses extra para indicar à função que todas as células selecionadas devem ser consideradas como um único intervalo, conforme abaixo:



Caso isto não seja feito, a célula apresentará um erro!

Bom, é isso. Espero que tenham gostado!

Para um próximo tópico, vou abordar como tornar esta e outras funções "parte" do Excel, inserindo-as num Suplemento. Desta forma, elas estarão associadas por padrão ao Excel instalado na máquina e poderão ser utilizadas sem a necessidade de trabalhar com o código em cada arquivo criado, ou ficarmos "Habilitando Macros" à cada novo uso do arquivo (supondo que as restrições de uso de macros estejam habilitadas na máquina).

Até a próxima!

quinta-feira, 13 de setembro de 2012

Somando Todos os Itens da Tabela Dinâmica

Boa noite, pessoal!

Fiz uma pequena macro hoje, para agilizar algumas formatações de tabela dinâmica que realizo com certa freqüência. 

Não sei se muita gente sofre com este problema, mas eu me incomodo bastante: Quando acrescentamos ao box de "Valores" da Tabela dinâmica um campo que possui espaços em branco, ao invés do Excel exibir por padrão a soma dos valores, é exibida a contagem dos mesmos.
Para evitar a necessidade de trocar individualmente os campos nesta situação (quando na verdade o que se quer é exibir a soma de todos os campos), segue o código abaixo. Ele configura como soma todos os campos na box de "Valores", de todas as tabelas dinâmicas da planilha.

Sub Tab_Din_Somar()

    Dim i As Integer
    Dim j As Integer
    
    For i = 1 To ActiveSheet.PivotTables.Count 'Passa por todas as tabelas dinâmicas da planilha
        For j = 1 To ActiveSheet.PivotTables(i).VisibleFields.Count 'Passa por todos os itens visiveis da tabela dinâmica
        
            With ActiveSheet.PivotTables(i).VisibleFields(j)
        
                If .Orientation > 3 Then 'Se for item de dados...
                    
                    On Error Resume Next 'Ignora erros ao passar por itens que não suportam configuração
                    .Function = xlSum 'Muda função para soma
                    .Name = "Soma de " & .SourceName 'Muda nome para "Soma de (...)"
            
                End If
            End With
        Next
    Next
End Sub

A macro é bastante simples, mas tive algumas dificuldades porque o código exibia insistentemente alguns erros ao apontar para .Function dentro de .PivotItems. Eliminei o problema evitando todas as boxes que não sejam a "Valores", e coloquei uma instrução para ignorar erros, para garantir que não hajam travamentos. Se alguém tiver algum problema com a macro e quiser compartilhar fiquem a vontade pois podemos refinar o código.

Espero que tenham gostado e que seja útil!

Até a próxima!

segunda-feira, 10 de setembro de 2012

Trabalhando com Strings

Pessoal,

Seguem algumas funções para se trabalhar com texto no Excel. São funções bastante básicas, mas muito poderosas para manipulação de frases ou palavras em células. Vamos a elas:

1) Funções DIREITA() e ESQUERDA()
Ambas utilizam o mesmo formato: DIREITA(Célula, Número_de_Caracteres). Por exemplo, ao referenciar uma célula que contenha a frase "A casa azul fica na esquina", e utilizando 7 como o número de caracteres, a fórmula resultará em "esquina". Segue abaixo o mesmo exemplo, utilizando uma figura como referência:



Obs.: Dependendo da versão do Excel, a vírgula utilizada para separação dos argumentos da função deverá ser substituída por um ponto-e-vírgula (;).

2) Função PROCURAR()
Esta função permite localizar dentro de uma frase a posição de um determinado caractere, palavra ou frase.
O formato dos parâmetros na função é PROCURAR(Palavra_Procurada, Célula, Caractere_Inicial). Por exemplo, na frase "De repente, um susto!", podemos descobrir a localização da vírgula referenciando a célula com esta frase, trocando a "Palavra_Procurada" por "," (incluindo as aspas, para indicar que é um texto) e colocando o número 1 como caractere inicial (para começar a busca a partir da primeira letra). A função irá retornar 11, pois a vírgula é o 11º caractere da frase. Segue imagem para exemplificar:


3) Função NÚM.CARACT()
Esta função retorna o número de caracteres de uma frase. O único parâmetro da função é a célula que contém o texto cujos caracteres devem ser contados, ou seja, NÚM.CARACT(Célula). Segue exemplo de contagem do número de letras na mesma frase do item anterior:


4) Função CONCATENAR()
Esta função permite agrupar o conteúdo de diversas células em uma única célula. Os parâmetros são inseridos na forma CONCATENAR(Célula1, Célula2, Célula3, [...]). Por exemplo, digamos que a Célula1 contenha a palavra "Pedra", a Célula2 contenha um espaço (" ") e a Célula3 contenha a palavra "Bonita". Concatenando as três palavras, teremos "Pedra Bonita", conforme exemplo que segue:



Aplicação

As três funções simples podem ser utilizadas em conjunto na resolução de um problema mais complexo.
Segue problema que solucionei há pouco tempo atrás para minha noiva: ela tinha nomes de diversas pessoas na coluna de uma planilha, com o seguinte formato: "Sobrenome, Primeiro nome + Segundo Nome" (ou "Silva, José Neves", para exemplificar). A intenção era remontar o conteúdo das células, para escrever os nomes da maneira usual. Como fazê-los usando as fórmulas acima? Vejamos a seguir.

Primeiro, usamos a função NÚM.CARACT() para determinar o número de caracteres da célula, conforme abaixo:


Agora, determinamos a posição da vírgula no meio do nome:


Com estas informações, podemos isolar o sobrenome e os primeiros nomes. Fazemos: ESQUERDA(Célula, Posição_da_Vírgula - 1) para separar o sobrenome. Segue figura com a fórmula:



Para separar os primeiros nomes, usamos a fórmula DIREITA(Célula, Nº_Caracteres - Posição_da_Vírgula - 1). Subtraímos uma posição adicional (1) além da posição da vírgula para eliminar também o espaço entre o sobrenome e os primeiros nomes. Segue imagem:


Agora, temos os componentes do nome separados. Basta então concatená-los para formar o nome completo (incluindo um espaço entre as partes) e na ordem que se desejava a princípio, conforme figura:


Podemos agora agrupar todas estas fórmulas em uma única célula e automatizar a conversão dos nomes de um formato para o outro, de maneira bem rápida e prática!

Espero que tenham gostado. Dúvidas ou sugestões, por favor, escrevam!

Até a próxima!

domingo, 9 de setembro de 2012

Básico de Macros - Criando uma Macro

Pessoal,

Segue um pequeno guia para usar os códigos disponibilizados no blog.
O procedimento para inclusão de uma macro em um arquivo do Excel é bastante simples. 
Vamos aos passos:

1) Em qualquer tela da sua planilha, digite "Alt + F11" para abrir o editor de Visual Basic. A tela será similar à imagem abaixo:


2) Clicar no menu "Inserir > Módulo". Uma tela como a que segue deve ser exibida:


3) Colar o código desejado na tela que se abriu. Aqui, irei utilizar o código de Formatação de Cabeçalhos. Após colar o código, fechar o editor.

4) Em qualquer tela no Excel, digite "Alt + F8". Irá aparecer uma pequena janela com todas as macros gravadas na planilha. Neste ponto, já poderíamos selecionar nossa macro e executá-la (clicando em "Executar") em um conjunto de células previamente selecionadas. Vamos, no entanto, criar um atalho para nossa macro. 


5) Selecione-a e clique em "Opções". Na área "Tecla de atalho", selecione a letra desejada (é possível usar letras maiúsculas e usar atalhos do tipo "Ctrl + Shift + Letra", e também é possível incluir uma breve descrição sobre a macro). Vamos usar a letra "h" minúscula neste exemplo. Preenchida a tecla de atalho, clicar em "OK" e, depois, em "Cancelar".


6) Agora, sempre que a tecla de atalho "Ctrl + h" for pressionada, a macro será executada. Selecione uma linha e execute a macro para verificar. Desta forma, temos uma nova função em nossa planilha, que pode ser utilizada rapidamente e sempre que precisarmos! 

É possível integrar uma ou mais macros ao Excel instalado no computador, agregando funções e permitindo que todo novo arquivo criado tenha estas funções habilitadas por padrão. Para tal, criamos um "Suplemento" e o adicionamos ao Excel. Este será um tópico futuro do blog!

7) Ao salvar o arquivo em versões mais recentes do Excel, será necessário usar um formato que suporte as macros para não perder o código inserido. Você pode selecionar o formato .xlsm (Pasta de Trabalho Habilitada para Macro do Excel), mas particularmente prefiro o .xlsb (Pasta de Trabalho Binária do Excel), por ter tamanho reduzido (maior compactação) quando utilizamos planilhas muito grandes.

Qualquer dúvida, escrevam!

Até a próxima!

Sugestões? Escreva!

Leitor,

Se você têm sugestões de tópicos a serem abordados ou algum trabalho no Excel que acredita que poderia ser otimizado de alguma forma, comente ou escreva para guiamacroexcel@gmail.com. Vou tentar ajudar!

Referenciando Tabelas Dinâmicas

Pessoal,

Segue uma dica: 

Quando vamos referenciar uma tabela dinâmica, incluindo seus campos em fórmulas, é padrão o Excel exibir a função "INFODADOSTABELADINÂMICA(...)" no campo. Esta função garante que a referência seja mantida mesmo com a troca de posição do campo ou modificação nos agrupamentos. Entretanto, para construção de relatórios e afins, nem sempre este método de referência é interessante e prático, além do quê, ele dificulta o "arrastar" das fórmulas por travar a referência.

É possível modificar este comportamento padrão e tornar a referência às tabelas dinâmicas igual a referência 
às outras células da planilha. Para tal, entrar em "Arquivo > Opções > Fórmulas", e desmarcar a opção "Usar Funções de GetPivotData para referências de tabela Dinâmica". Segue imagem da opção desmarcada:


Depois que passei a usar a referência desta maneira, o uso e referência às tabelas dinâmicas ficou muito mais intuitivo!

Até a próxima!

sábado, 8 de setembro de 2012

Formatando Cabeçalhos


Pessoal, 

Segue mais uma macro para facilitar o dia-a-dia.
No trabalho, tenho de montar apresentações diariamente, formatando muitas tabelas.
Com esta macro, padronizei os cabeçalhos que uso, para ganhar tempo. Basta selecionar a área da linha com o cabeçalho e aplicar a macro (a cor pode ser alterada e a disposição das bordas, também... O código está comentado):


Sub Formata_Cabeçalho()
'
' Macro para formatar cabeçalhos automaticamente
'

    With Selection.Font 'Formata fonte na cor branca/negrito
        .FontStyle = "Negrito"
        .ThemeColor = xlThemeColorDark1
    End With
    
    With Selection.Borders(xlInsideVertical) 'Borda para separação das colunas
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .Weight = xlThin
    End With
    
    'Retira outras bordas
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    
    'Preenchimento do cabeçalho (cor)
    With Selection.Interior
        .Pattern = xlSolid
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = -0.499984740745262
    End With
    
    'Alinhamento do cabeçalho (centralizado/quebra de linha)
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With
    
End Sub

Segue imagem de como ficaria o cabeçalho:


Até a próxima!

Macro para Formatar Tabelas Dinâmicas


Bom dia, pessoal!
Segue uma macro bastante simples, para padronizar o modo de exibição de uma tabela dinâmica em uma planilha. Criei esta macro para poder voltar ao formato padrão que prefiro depois de criar ou modificar uma tabela. O texto está comentado, e alguns parâmetros podem ser alterados (exibir ou não o total por colunas e formatar o relatório no estilo de tabela):
Sub Formata_Dinamicas()
'
' Personaliza formatação das tabelas dinâmicas
'

Dim N_Pivot As Integer
Dim N_Pivot_Fields As Integer

N_Pivot = 1

    While N_Pivot <= ActiveSheet.PivotTables.Count 'Passa por todas as tabelas dinâmicas da planilha

        ActiveSheet.PivotTables(N_Pivot).RowAxisLayout xlTabularRow 'Relatório em formato de tabela
        ActiveSheet.PivotTables(N_Pivot).RowGrand = False 'Elimina totais por linha
        ActiveSheet.PivotTables(N_Pivot).ColumnGrand = True 'Mantém totais por coluna

        For N_Pivot_Fields = 1 To ActiveSheet.PivotTables(1).PivotFields.Count 'Elimina subtotais
            If ActiveSheet.PivotTables(N_Pivot).PivotFields(N_Pivot_Fields).Orientation = xlRowField Then

                On Error Resume Next 'Ignora erro ao passar pelo campo de somatória
                ActiveSheet.PivotTables(N_Pivot).PivotFields(N_Pivot_Fields).Subtotals = _
                    Array(False, False, False, False, False, False, False, False, False, False, False, False)

            End If

        Next

        N_Pivot = N_Pivot + 1

    Wend

End Sub


Até a próxima!