Macro - Whats wrong?

[NPell]

Whatrs wrong with this??

I either get an error saying no data, or can not be used with multiple
selection.

Sheets("Data").Select
Selection.AutoFilter Field:=10, Criteria1:="Criteria 1"
Range("A1").Offset(1, 0).Select
Range("A1:I1").Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeConstants, xlNumbers +
xlTextValues).Select
On Error GoTo ErrorTrap1
Selection.Copy
lastrow = Sheets("Criteria 1").Cells(Rows.Count,
"A").End(xlUp).Row
Sheets("Criteria 1").Range("A" & lastrow + 1).PasteSpecial
ErrorTrap1:
Application.CutCopyMode = False
Range("A1").Select

Sheets("Data").Select
Selection.AutoFilter Field:=10, Criteria1:="Criteria 2"
Range("A1").Offset(1, 0).Select
Range("A1:I1").Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeConstants, xlNumbers +
xlTextValues).Select
On Error GoTo ErrorTrap2
Selection.Copy
lastrow = Sheets("Criteria 2").Cells(Rows.Count,
"A").End(xlUp).Row
Sheets("Criteria 2").Range("A" & lastrow + 1).PasteSpecial
ErrorTrap2:
Application.CutCopyMode = False
Range("A1").Select



Any advice?

 

[Bernie Deitrick]

Try it this way:

Sub TryNow()
Dim myA As Variant
Dim myV As Variant

myA = Array("Criteria 1", "Criteria 2")

For Each myV In myA
Sheets("Data").Range("A:J").AutoFilter Field:=10, Criteria1:=myV
Intersect(Range("A1").CurrentRegion, Range("A2:I" & Rows.Count)) _
.SpecialCells(xlCellTypeVisible).Copy _
Sheets(myV).Cells(Rows.Count, "A").End(xlUp)(2)
Sheets("Data").Cells.AutoFilter
Next myV
End Sub

 

[NPell]

Try it this way:

Sub TryNow()
Dim myA As Variant
Dim myV As Variant

myA = Array("Criteria 1", "Criteria 2")

For Each myV In myA
Sheets("Data").Range("A:J").AutoFilter Field:=10, Criteria1:=myV
Intersect(Range("A1").CurrentRegion, Range("A2:I" & Rows.Count)) _
   .SpecialCells(xlCellTypeVisible).Copy _
Sheets(myV).Cells(Rows.Count, "A").End(xlUp)(2)
Sheets("Data").Cells.AutoFilter
Next myV
End Sub

--
HTH,
Bernie
MS Excel MVP










- Show quoted text -

I will give that a go, thanks Bernie

 

[NPell]

Try it this way:

Sub TryNow()
Dim myA As Variant
Dim myV As Variant

myA = Array("Criteria 1", "Criteria 2")

For Each myV In myA
Sheets("Data").Range("A:J").AutoFilter Field:=10, Criteria1:=myV
Intersect(Range("A1").CurrentRegion, Range("A2:I" & Rows.Count)) _
   .SpecialCells(xlCellTypeVisible).Copy _
Sheets(myV).Cells(Rows.Count, "A").End(xlUp)(2)
Sheets("Data").Cells.AutoFilter
Next myV
End Sub

--
HTH,
Bernie
MS Excel MVP










- Show quoted text -

I got "Error - No Cells Were Found" on Criteria 1, as it is blank.

 

[NPell]

I got "Error - No Cells Were Found" on Criteria 1, as it is blank.- Hide quoted text -

- Show quoted text -

Added an "On Error Resume Next". All sorted.
Thanks very much Bernie mate.