Segui o esquema apresentado no topico viewtopic.php?f=10&t=2985 , mas a macro nao quer disparar.
Basicamente eu preciso que quando inserir o valor na celula AL8 uma macro de filtrar seja executada tendo como criterio o valor inserido em AL8.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$AL$8" Then
Call Filtrar
Exit Sub
End If
End Sub
Sub Filtrar()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
On Error Resume Next
If Range("AL8") = "AAA" Then filtro = 1
If Range("AL8") = "BBB" Then filtro = 2
If Range("AL8") = "CCC" Then filtro = 3
If Range("AL8") = "DDD" Then filtro = 4
If Range("AL8") = "EEE" Then filtro = 5
If Range("AL8") = "FFF" Then filtro = 6
Select Case filtro
Case 1
ActiveSheet.Range("$AL$9:$BG$4054").AutoFilter Field:=2, Criteria1:="="
ActiveSheet.Range("$AL$9:$BG$4054").AutoFilter Field:=3, Criteria1:="<>"
Range("AQ8:BF8").Select
Selection.Copy
Range("BJ2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("AK7").Select
Case 2
ActiveSheet.Range("$AL$9:$BG$4054").AutoFilter Field:=2, Criteria1:="BBB"
ActiveSheet.Range("$AL$9:$BG$4054").AutoFilter Field:=3, Criteria1:="<>"
Range("AQ8:BF8").Select
Selection.Copy
Range("BJ3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("AK7").Select
Case 3
ActiveSheet.Range("$AL$9:$BG$4054").AutoFilter Field:=2, Criteria1:="CCC"
ActiveSheet.Range("$AL$9:$BG$4054").AutoFilter Field:=3, Criteria1:="<>"
Range("AQ8:BF8").Select
Selection.Copy
Range("BJ4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("AK7").Select
Case 4
ActiveSheet.Range("$AL$9:$BG$4054").AutoFilter Field:=2, Criteria1:="DDD"
ActiveSheet.Range("$AL$9:$BG$4054").AutoFilter Field:=3, Criteria1:="<>"
Range("AQ8:BF8").Select
Selection.Copy
Range("BJ5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("AK7").Select
Case 5
ActiveSheet.Range("$AL$9:$BG$4054").AutoFilter Field:=2, Criteria1:="EEE"
ActiveSheet.Range("$AL$9:$BG$4054").AutoFilter Field:=3, Criteria1:="<>"
Range("AQ8:BF8").Select
Selection.Copy
Range("BJ6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("AK7").Select
Case 6
ActiveSheet.ShowAllData
End Select
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
Postado : 14/02/2013 9:18 pm