Excel VBA - ocultar colunas que nao contenham os dados pre definidos no cabeçalho

[JOVANCIRCARIS]

Ola, estou tentando escrever um codigo no qual a partir de um cabeçalho/Titulo oculte demais colunas que nao tenham aquele cabecalho/titulo.

 

No exemplo abaixo eu tenho o cabeçalho/titulo = A; B; C; D eu gostaria de poder localizar os cabeçalhos/titulo A e C e ocultar todos outros.

 

 

Desde ja agradeço a ajuda;

[CasaDoHardware]

Essa escolha tem algum criterio, ou é a coluna que der na telha?

[JOVANCIRCARIS]

 

@CasaDoHardware

 

A escolha tem um critério pois vou realizar esta formatação ( ocultar colunas) em varias planilhas a partir de uma planilha com um determinado cabeçalho/titulo.

[CasaDoHardware]

Otimo!

 

Agora qual o criterio?

Onde buscar a informação?

[JOVANCIRCARIS]

@CasaDoHardware Entao, preciso que ele busque os Titulos "A" e "C", neste exemplo seria ocultado as colunas "B" e "D"

adicionado 13 minutos depois

@CasaDoHardware Pensei no codigo abaixo: 

 

Sub teste()

Range("A1").Select

If ActiveCell <> "A" Then
    If ActiveCell <> "C" Then
        Selection.EntireColumn.Hidden = True
    End If

End If

Range("B1").Select
If ActiveCell <> "A" Then
    If ActiveCell <> "C" Then
        Selection.EntireColumn.Hidden = True
    End If

End If

Range("C1").Select
If ActiveCell <> "A" Then
    If ActiveCell <> "C" Then
        Selection.EntireColumn.Hidden = True
    End If

End If

Range("D1").Select
If ActiveCell <> "A" Then
    If ActiveCell <> "C" Then
        Selection.EntireColumn.Hidden = True
    End If

End If

Range("E1").Select
If ActiveCell <> "A" Then
    If ActiveCell <> "C" Then
        Selection.EntireColumn.Hidden = True
    End If

End If

End Sub

 

 

ele Funciona mas acho que deve existir algo mais "inteligente" de se fazer.

 

 

[CasaDoHardware]

Sendo assim!!

 

Use este codigo.

 

Considerei o titulo na linha 1.

 

Sub ocultarcoluna()

Dim Coluna As Integer

For Coluna = 1 To Cells(1, Cells.Columns.Count).End(xlToLeft).Column

If Cells(1, Coluna).Value <> "a" _
And Cells(1, Coluna).Value <> "c" Then

Columns(Coluna).EntireColumn.Hidden = True

End If

Next Coluna

End Sub

[Visitante]

Experimente:

Sub OcultaColunas()
 Dim k As Long, c As Range
  Columns.Hidden = False
  For Each c In Range("A1", Cells(1, Columns.Count).End(1))
   Select Case c.Value
   Case "A", "C"
   Case Else: Columns(c.Column).Hidden = True
   End Select
  Next c
End Sub

1. funciona para qualquer quantidade de colunas com cabeçalho

2. manterá visíveis as colunas com cabeçalho "A" e "B", acrescente quantos cabeçalhos desejar