Gabriel, se entendi, você tem de limpar os resultados para realizar nova filtragem, se for isto troque a rotina pelas abaixo, é só apagar toda e colar estas :
Utilizei uma dica para capturar a Ultima Coluna e Linha com dados, uma vez que teremos Colunas dinamicas, a fonte está na rotina :
Sub VerificaDatasCopia()
Dim lgColDt As Long, k As Long
Dim lastRow As Long
Dim sColDestino As Long
Dim sDtIni
Dim sDtFim
'Chama a rotina para limpar a aba Resultado
'antes de filtrar novamente
Call LimpaDynamicRange
sDtIni = Range("B2").Value
sDtFim = Range("E2").Value
'Conta as colunas com datas
lgColDt = Cells(5, Columns.Count).End(xlToLeft).Column
'1ª Coluna aba destino
sColDestino = 3
Application.ScreenUpdating = False
For k = 3 To lgColDt
lastRow = Cells(65536, k).End(xlUp).Row 'ultima linha na coluna
'Condição das Datas
If CDate(Cells(5, k).Value) >= CDate(sDtIni) _
And CDate(Plan1.Cells(5, k).Value) <= CDate(sDtFim) Then
'Copia
Range(Cells(5, k), Cells(lastRow, k)).Copy
'Cola somente os valores sem formula
Worksheets("Resultado").Cells(5, sColDestino).PasteSpecial xlPasteValues
'Incrementa a coluna destino
sColDestino = sColDestino + 1
End If
Next k
Worksheets("Resultado").Select
Worksheets("Resultado").Range("A1").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
'Adaptação do site abaixo
'Use Last Column for a Range(F:LastColumn)
'http://stackoverflow.com/questions/16941083/use-last-column-for-a-rangeflastcolumn
Sub LimpaDynamicRange()
Dim startCol As String
Dim startRow As Long
Dim lastRow As Long
Dim lastCol As Long
Dim myCol As String
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Set ws = ThisWorkbook.Sheets("Resultado")
startCol = "C"
startRow = 5
lastRow = ws.Range(startCol & ws.Rows.Count).End(xlUp).Row
lastCol = ws.Cells(5, ws.Columns.Count).End(xlToLeft).Column
myCol = GetColumnLetter(lastCol)
Set rng = ws.Range(startCol & startRow & ":" & myCol & lastRow)
rng.ClearContents
End Sub
Function GetColumnLetter(colNum As Long) As String
Dim vArr
vArr = Split(Cells(1, colNum).Address(True, False), "$")
GetColumnLetter = vArr(0)
End Function
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 07/04/2015 8:12 am