Views

VBA Excel - Autofiltro - Copiando Linhas filtradas específicas, com os títulos - Excel List AutoFilter VBA - Copy Filtered List Rows With Headings



Segue mais um exemplo de programação VBA para manipular AutoFiltro no MS Excel. 

O uso desse código nas listas de dados contidas nas tabelas das nossas planilhas.

Quando nomeamos as nossas tabelas de dados constituimos um ListObject, o qual automaticamente recebe a sua própria propriedade AutoFiltro.

Autofiltro - Mostrando todos os registros (Show All Records)
Autofiltro - Acionando o AutoFiltro da nossa Lista (Turn On List AutoFilter)
Autofiltro - Desligando a Lista de AutoFiltro (Turn Off List AutoFilter)
Autofiltro - Contando as Listas de AutoFiltros (Count List AutoFilters)
Autofiltro - Ocultando todas as Setas da lista de AutoFiltro, exceto uma (Hide Arrows Specific Columns)
Autofiltro - Ocultando Setas específicas nas listas de AutoFiltro (Hide Arrows Specific Columns)
Autofiltro - Visualizar todas as setas da Lista AutoFiltro (Show All List AutoFilter Arrows)
Autofiltro - Copiando Linhas filtradas específicas, sem os títulos (Copy Filtered List Rows Without Headings)
Autofiltro - Copiando Linhas filtradas específicas, com os títulos (Copy Filtered List Rows With Headings)
Autofiltro - Conte as Linhas Visíveis da Lista (Count Visible List Rows)

Copiando Linhas filtradas específicas, com os títulos

O código abaixo copia as linhas filtradas, e as suas respectivas posições, com os títulos.

Sub CopyFilteredRowsAndHeadingsList1()
Dim wsL As Worksheet
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim Lst As ListObject

Let Application.ScreenUpdating = False

Set wsL = ActiveSheet
Set Lst = wsL.ListObjects(1)

With Lst.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
       .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With

If rng2 Is Nothing Then
   MsgBox "Sem dados para copiar."
Else
   Set ws = Sheets.Add
   Set rng = Lst.AutoFilter.Range

   ' Copia as Linhas com os seus cabeçalhos.
   rng.SpecialCells(xlCellTypeVisible).Copy _
     Destination:=ws.Range("A1")
End If
   
Let Application.ScreenUpdating = True
End Sub
Tags: VBA, Excel, List, AutoFilter, autofiltro, worksheet, Show, Arrows, Specific Columns, Rows, With Headings,



Tags: , , , , , , , , , ,

Nenhum comentário:

Postar um comentário

Assinar: Postar comentários (Atom)
diHITT - Notícias