Filter trought rows

[JuanchoCR]

Hi,

I have this code, but isn't working.
The code is recognize the first row but now going to the next one and filter the others rows.
Any suggestions?

Sub filter4()


Dim rng As range
Dim ul As Long
Dim celda As Variant
Dim lr As Long



ul = Worksheets("Count").Cells(Rows.Count, "A").End(xlUp).Row
lr = Worksheets("List").Cells(Rows.Count, "D").End(xlUp).Row
Set rng = ActiveWorkbook.Sheets("Count").range("A2")
Set celda = Worksheets("Count").range("A2")




For celda = 1 To ul


Sheets("Temp").Select
range("A:D").Delete
Sheets("List").Select

If celda <> "" Then
Worksheets("List").range("$A$1:$D$66").AutoFilter Field:=2, Criteria1:=rng

Sheets("Count").Select
ActiveCell.Offset(1, 0).Select

End If

Selection.CurrentRegion.Copy
Sheets("Temp").Select
range("A1").PasteSpecial xlPasteValues
range("A1").PasteSpecial xlPasteFormats
Cells.EntireColumn.AutoFit


Next celda