Macro - Whats wrong?

N

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?
 
B

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
 
N

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
 
N

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.
 
N

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.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Macro - How to not copy blank criteria? 1
VBA for Dependents shortcut menu 0
End(xlDown) Issue 1
Select used range 2
Saving a range for later reference 0
Array 1
Help merging two VBA codes 2
Help me4 2

Top