| Descricao: |
 Saberexcel - O site de quem precisa aprender macros Microsoft Excel VBA
Esse macro do Aplicativo Microsoft Excel VBA(Visual Basic Application), filtra determinados ítens de uma tabela da folha de Planilha principal, para as referidas folhas de planilhas conforme critério na tabela, isto é, distribui dados para as folhas de planilhas correspondentes, filtrando os dados.
Observe que o macro monta os cabeçalhos e retorna os dados relacionados a folha de planilha, montando um relatório para cada ítem e também
organiza na ordem crescente por data, há uma subrotina para essa finalidade, chamada Sub Ordenar_Dados(Argumentos).
Option Explicit
Dim vTabela_Recap() As Variant
Sub Distribuir_dados_planilhas()
Dim Tableau_Recup As Variant
Dim L As Integer, Item As Integer, vUltimaLinha As Integer, x As Integer
Dim Col As Byte, vUltimaColuna As Byte
Dim vNomePlanilha As String
Dim vColecaoPlanilhas As Collection
Dim vTabela_Cabecalho(4) As Variant
vTabela_Cabecalho(0) = "DATA"
vTabela_Cabecalho(1) = "NOME-SOBRENOME"
vTabela_Cabecalho(2) = "PLANILHA"
vTabela_Cabecalho(3) = "PRE-INSRIÇÃO"
Set vColecaoPlanilhas = New Collection
x = -1
With Worksheets("Dados")
vUltimaLinha = .Range("A65536").End(xlUp).Row
vUltimaColuna = .Range("IV7").End(xlToLeft).Column
Tableau_Recup = .Range(.Cells(7, 1), .Cells(vUltimaLinha, vUltimaColuna))
On Error Resume Next
For L = 2 To UBound(Tableau_Recup, 1)
vColecaoPlanilhas.Add Tableau_Recup(L, 3), CStr(Tableau_Recup(L, 3))
Next
On Error GoTo 0
Err.Clear
End With
Application.ScreenUpdating = False
For L = 1 To vColecaoPlanilhas.Count
vNomePlanilha = vColecaoPlanilhas(L)
With Worksheets(vNomePlanilha)
vUltimaLinha = .Range("A65536").End(xlUp).Row + 1
vUltimaColuna = .Range("IV7").End(xlToLeft).Column
.Range(.Cells(6, 1), .Cells(vUltimaLinha, vUltimaColuna)).ClearContents
For Item = 1 To UBound(Tableau_Recup, 1)
If vColecaoPlanilhas(L) = Tableau_Recup(Item, 3) Then
x = x + 1
ReDim Preserve vTabela_Recap(4, x)
vTabela_Recap(0, x) = Tableau_Recup(Item, 1) 'data
vTabela_Recap(1, x) = Tableau_Recup(Item, 2) 'nome sobrenome
vTabela_Recap(2, x) = Tableau_Recup(Item, 3) 'planilha
vTabela_Recap(3, x) = Tableau_Recup(Item, 4) 'Preinscrição
End If
Next
'chamando a subrotina
Ordenar_Dados vTabela_Recap
For Item = 0 To UBound(vTabela_Cabecalho, 1)
.Cells(1, 1) = "Planilha"
.Cells(1, 2) = vNomePlanilha
.Cells(5, 1 + Item) = vTabela_Cabecalho(Item)
Next
vUltimaLinha = .Range("A65536").End(xlUp).Row + 1
.Range("A" & vUltimaLinha).Resize(UBound(vTabela_Recap, 2) + 1, UBound(vTabela_Recap, 1)) = Application.Transpose(vTabela_Recap)
End With
Application.ScreenUpdating = True
x = -1
vNomePlanilha = ""
Erase vTabela_Recap
Next
MsgBox ("Dados filtrados e separados por ordem com sucesso!!"), vbInformation, "Saberexcel - o site das macros"
End Sub
'rotina para ordenar os dados em ordem crescente , é chamada no macro acima : Ordenar_Dados vTabela_Recap
Sub Ordenar_Dados(ByVal T As Variant)
Dim Col As Integer, Col2 As Integer
Dim Tmp1 As Variant, Tmp2 As Variant, Tmp3 As Variant, Tmp4 As Variant
For Col = 0 To UBound(T, 2)
For Col2 = 0 To UBound(T, 2)
If T(0, Col2) > T(0, Col) Then
Tmp1 = T(0, Col): Tmp2 = T(1, Col): Tmp3 = T(2, Col): Tmp4 = T(3, Col)
T(0, Col) = T(0, Col2): T(1, Col) = T(1, Col2): T(2, Col) = T(2, Col2): T(3, Col) = T(3, Col2)
T(0, Col2) = Tmp1: T(1, Col2) = Tmp2: T(2, Col2) = Tmp3: T(3, Col2) = Tmp4
End If
Next
Next
vTabela_Recap = T
End Sub
Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel
Publicidade
Compre com segurança, garantia e ótimos preços
|