autofilter

[Don Meeker]

I have a range that I autofilter and then copy a subtotal to another sheet.
I have a column of specific dates in col 1 of sheet3 that represent each
date I need to autofilter for. Is there a way to loop down through the dates
on sheet3 and then use each successive loop (cell) value for my variable
Data1 which is my Criteria1 autofilter sort value?

Thanks,
Don


Sub Macro1()

Dim Data1 As String
Dim Data2 As String

Data1 = Sheets("Sheet3").Cells(2, 1).Value
Data2 = Sheets("Sheet3").Cells(3, 1).Value
Data3 = Sheets("Sheet3").Cells(4, 1).Value
Data4 = Sheets("Sheet3").Cells(5, 1).Value

nextrow = Range("J2000").End(xlUp).Row + 1

Sheets("Sheet1").Select
Range("A3:I3000").Select
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:=Data1
Range("E1:I1").Select
Selection.Copy
Sheets("Sheet3").Select
nextrow = Range("J2000").End(xlUp).Row + 1
Cells(nextrow, 10).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Calculate
Sheets("Sheet1").Select
Range("A3:I3000").Select
Selection.AutoFilter
Calculate
Selection.AutoFilter Field:=2, Criteria1:=Data2
Range("E1:I1").Select
Selection.Copy
Sheets("Sheet3").Select
nextrow = Range("J2000").End(xlUp).Row + 1
Cells(nextrow, 10).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

 

[GJones]

Hi Don;

You can do it using VBA. Here is an example of how it
might go;


Sub try()

Range("A1:E5").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="2"

Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("ResultsSheet").Select
ActiveSheet.Paste


End Sub

 

[Don Meeker]

Thanks for your help but I really was interested in looping through a
Criteria1 value (from another sheet) when autofiltering. This is what I
came up with and it is working:

Sub LoopTry()

For Count = 1 To Sheets("Sheet3").Range("A20000").End(xlUp).Row
Data1 = Sheets("Sheet3").Cells(Count, 1).Value
Calculate
Sheets("Sheet1").Select
Range("A3:I3000").Select
Selection.AutoFilter
Calculate
Selection.AutoFilter Field:=2, Criteria1:=Data1
Range("E1:I1").Select
Selection.Copy
Sheets("Sheet3").Select
nextrow = Range("B2000").End(xlUp).Row + 1
Cells(nextrow, 2).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Next Count

End Sub