can anybody speed up this macro

[matthias]

Hello guys, i have the following macro that works but it goes very
slowly

What it does, is that applies an autofilter on several columns and then
copies the filtered values from column 1 to a new sheet. If you know
that when there is no filtered range (so there are no values that
fulfill the criterium) nothing has to be copied, is it possible to
speed it up with a if autofilter.range is empty then do next or
something??

thankx

Worksheets("General fields").Activate
Selection.AutoFilter field:=8, Criteria1:="<>"
ActiveSheet.AutoFilter.Range.Columns(1).Copy
Destination:=Worksheets("Temp").Range("a2")
Selection.AutoFilter field:=8



'short call
Worksheets("General fields").Activate
Selection.AutoFilter field:=9, Criteria1:="<>"
ActiveSheet.AutoFilter.Range.Columns(1).Copy
Destination:=Worksheets("Temp").Range("a98")
Selection.AutoFilter field:=9


'rsu
Worksheets("General fields").Activate
Selection.AutoFilter field:=12, Criteria1:="<>"
ActiveSheet.AutoFilter.Range.Columns(1).Copy
Destination:=Worksheets("Temp").Range("a26")
Selection.AutoFilter field:=12

'espp
Worksheets("General fields").Activate
Selection.AutoFilter field:=13, Criteria1:="<>"
ActiveSheet.AutoFilter.Range.Columns(1).Copy
Destination:=Worksheets("Temp").Range("a50")
Selection.AutoFilter field:=13

'f shares
Worksheets("General fields").Activate
Selection.AutoFilter field:=14, Criteria1:="<>"
ActiveSheet.AutoFilter.Range.Columns(1).Copy
Destination:=Worksheets("Temp").Range("a74")
Selection.AutoFilter field:=14

'top hat
Worksheets("General fields").Activate
Selection.AutoFilter field:=16, Criteria1:="<>"
ActiveSheet.AutoFilter.Range.Columns(1).Copy
Destination:=Worksheets("Temp").Range("a122")
Selection.AutoFilter field:=16

'pension
Worksheets("General fields").Activate
Selection.AutoFilter field:=17, Criteria1:="<>"
ActiveSheet.AutoFilter.Range.Columns(1).Copy
Destination:=Worksheets("Temp").Range("a128")
Selection.AutoFilter field:=17

'degroof AM
Worksheets("General fields").Activate
Selection.AutoFilter field:=19, Criteria1:="<>"
ActiveSheet.AutoFilter.Range.Columns(1).Copy
Destination:=Worksheets("Temp").Range("a133")
Selection.AutoFilter field:=19

'degroof ANM
Worksheets("General fields").Activate
Selection.AutoFilter field:=20, Criteria1:="<>"
ActiveSheet.AutoFilter.Range.Columns(1).Copy
Destination:=Worksheets("Temp").Range("a140")
Selection.AutoFilter field:=20

'other bank
Worksheets("General fields").Activate
Selection.AutoFilter field:=21, Criteria1:="<>"
ActiveSheet.AutoFilter.Range.Columns(1).Copy
Destination:=Worksheets("Temp").Range("a147")
Selection.AutoFilter field:=21

'other
Worksheets("General fields").Activate
Selection.AutoFilter field:=23, Criteria1:="<>"
ActiveSheet.AutoFilter.Range.Columns(1).Copy
Destination:=Worksheets("Temp").Range("a152")
Selection.AutoFilter field:=23

'liabilities
Worksheets("General fields").Activate
Selection.AutoFilter field:=24, Criteria1:="<>"
ActiveSheet.AutoFilter.Range.Columns(1).Copy
Destination:=Worksheets("Temp").Range("a157")
Selection.AutoFilter field:=24


Worksheets("Temp").Buttons.Delete
Worksheets("General fields").Activate
Selection.AutoFilter field:=6

 

[Don Guillett]

something like this (UN tested). I would also change selection to the
range("a2:z2")

Worksheets("General fields").Activate
myarray = Array(8, 9, 12, 13)
For Each i In myarray
'MsgBox i
lastrow=sheets("Temp").cells(.rows.count,"a").end(xlup).row+1
Selection.AutoFilter field:=i, Criteria1:="<>"
ActiveSheet.AutoFilter.Range.Columns(1).Copy _
Worksheets("Temp").cells(lastrow,"a")
Next i

 

[Guest]

you can use
set rng = activesheet.autofilter.Range.columns(8).cells
if application.countA(rng) > 1 then ' assume header is not empty
' apply the autofilter and copy
else
' skip this one
end if