VBA - Copy cells after filter applied (wrong result)

[daniel.aquere]

Hi everyone,


I´m having a strange problem...


When I applied a filter like this:


Dim termino As Date
Dim termino2 As Date

termino = Range("S2").Value
termino2 = DateAdd("d", 7, Range("S2").Value)

Sheets("Expansao - Cronograma GP").Select
ActiveSheet.Range("F3:H100").AutoFilter Field:=1, Criteria1:=">" & Format(termino, "mm/dd/yyyy"), Operator:=xlAnd, Criteria2:="<=" & Format(termino2, "mm/dd/yyyy")


Then I copy and past the result:


Sheets("Expansao - Cronograma GP").Select
Range("F4:H100").Select
Selection.Copy
Sheets("Painel Regina Expansao v1").Select
Range("AI10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


This works fine when the filter return some line, if the filter don´t return any row, my copy/paste copy ALL rows in the source sheet. The correct is don´t copy any row!

Sample available in: http://www.pmpartner.com.br/VBA filter - copy-paste - sample.xlsm
(Module 7 - Sub "e_Filtrar_Painel_Regina_03_Inicio_Proxima_Semana_01_LEVANTAMENTO", called by button "APPLY FILTER" on AI column from "Painel Regina Expansao v1" sheet)


I appreciate any tips.


Best


Daniel

 

[AlphaFrog]

Try this...

    Sheets("Expansao - Cronograma GP").Range("F3:H100").AutoFilter _
        Field:=1, Criteria1:=">" & [color=darkblue]CLng[/color](termino), Operator:=xlAnd, Criteria2:="<=" & [color=darkblue]CLng[/color](termino2)
    
    [color=green]' Test if any visible rows[/color]
    [color=darkblue]If[/color] Sheets("Expansao - Cronograma GP").Range("C" & Rows.Count).End(xlUp).Row > 3 [color=darkblue]Then[/color]
    
        [color=green]' copia bandeira e lojas[/color]
        Sheets("Expansao - Cronograma GP").Range("C4:D100").SpecialCells(xlCellTypeVisible).Copy
        Sheets("Painel Regina Expansao v1").Range("AG10").PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            
        [color=green]' copia inicio, termino e duração[/color]
        Sheets("Expansao - Cronograma GP").Range("F4:H100").SpecialCells(xlCellTypeVisible).Copy
        Sheets("Painel Regina Expansao v1").Range("AI10").PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        
    [color=darkblue]End[/color] [color=darkblue]If[/color]

 

[daniel.aquere]

Hi AlphaFrog,

Works great!!!

Thanks for help.

Best, Daniel