Uma das razões pela qual utilizamos a função FILTRAR [FILTER] no Excel é para obter um conjunto de dados individualizados sobre um determinado critério. Com a função FILTAR esses dados podem ser dinamicamente apresentados num relatório à parte, por exemplo numa nova folha ou mesmo num novo ficheiro.
Neste sentido, esse relatório, pode ser exportado instantaneamente para cada critério do FILTRO. É isso que vamos fazer neste Tutorial.
Preparar os dados
Começamos por preparar os dados convertendo o intervalo numa tabela.

A tabela é definida com cabeçalhos.

E damos o nome à tabela: Marcas.

Definir a lista com todas as possíveis marcas da tabela
Uma vez que a tabela pode ter dados no futuro, vamos criar uma lista dinâmica, sem duplicados, com as marcas, utilizando a função EXCLUSIVOS [UNIQUE].
=EXCLUSIVOS(Marcas[Marca])

Esta lista será utilizada pela rotina em VBA, para correr todos os itens da lista, e aplicar o filtro de uma forma dinâmica e instantânea no relatório.
De seguida criamos uma folha para o relatório.

Definir os dados do relatório
No relatório vamos ter apenas uma extração simples dos dados, mas podes formatar o relatório a teu gosto. A função FILTRAR neste caso filtra apenas os dados da tabela, sendo que o cabeçalho é definido na folha.
Uma vez que o valor da célula E3, onde vai constar o critério para o filtro está sem valor, colocamos o último argumento da função [se_vazia] com um valor “Sem Dados”.
Este valor da célula E3 será preenchido através do código VBA.
=FILTRAR(Marcas;Marcas[Marca]=E3;”Sem Dados”)

Criar a rotina em VBA
Começamos por aceder ao menu Programador [Developer] e ao comando .

A seguir criamos um módulo para conter o código.

No novo módulo começamos por definir as variáveis que vão ser utilizadas:
- Uma variável [Célula] para determinar o valor da célula que identifica a marca.
- Uma variável [Intervalo] para determinar o intervalo com a lista de marcas que será iterado pelo ciclo.
- Uma variável [Caminho] para guardar o caminho onde serão guardados os PDF. Esta variável é opcional, mas facilita a lógica caso o utilizador pretenda mudar o caminho no futuro.
Sub ExportarIntervalo()
Dim Celula As Range
Dim Intervalo As Range
Dim Caminho As String
End Sub
A seguir atribuímos as variáveis aos objetos.
Sub ExportarIntervalo()
Dim Celula As Range
Dim Intervalo As Range
Dim Caminho As String
Folha1.Activate
‘ Definir o Intervalo com uma variável através da lista única
Set Intervalo = Folha1.Range(“I3”, Range(“I3”).End(xlDown))
‘ Definir o caminho a guardar o ficheiro
Caminho = ThisWorkbook.Path
No próximo passo do código podemos aplicar algumas configurações à página.
With Folha2.PageSetup
.PrintArea = “$A$1:$H$20” ‘Definir a área de impressão
.Orientation = xlLandscape ‘Definir a orientação da página
.CenterHorizontally = True ‘Centrar a área de impressão (horizontal)
.CenterVertically = True ‘Centrar a área de impressão (vertical)
End With
Na última parte do código, definimos o ciclo que vai correr cada marca da lista, colocar o valor na célula para aplicar o critério do filtro e ainda exportar cada filtro para um ficheiro em formato PDF independente.
For Each Celula In Intervalo
Folha2.Range(“E3”).Value = Celula.Value
Folha2.ExportAsFixedFormat xlTypePDF, Caminho & “\” & Celula.Text
Next Celula
End Sub
Assim o código completo da rotina é o indicado em baixo.
Sub ExportarIntervalo()
Dim Celula As Range
Dim Intervalo As Range
Dim Caminho As String
Folha1.Activate
‘ Definir o Intervalo com uma variável através da lista única
Set Intervalo = Folha1.Range(“I3”, Range(“I3”).End(xlDown))
‘ Definir o caminho a guardar o ficheiro
Caminho = ThisWorkbook.Path
‘ Definir as propriedades para a folha a imprimir
With Folha2.PageSetup
.PrintArea = “$A$1:$H$20” ‘ Definir a área de impressão
.Orientation = xlLandscape ‘ Aplicar a orientação da página
.CenterHorizontally = True ‘ Centrar na horizontal
.CenterVertically = True ‘ Centrar na vertical
End With
‘ Definir o ciclo para o Filtro
For Each Celula In Intervalo
Folha2.Range(“E3”).Value = Celula.Value
Folha2.ExportAsFixedFormat xlTypePDF, Caminho & “\” & Celula.Text
Next Celula
End Sub

Leave a Reply