Macro - How to not copy blank criteria?

[NPell]

Hello all,

I have a macro, which is designed to take a Data sheet and then filter
on a column. With this Criteria i want it to distribute to the
indiviudal tabs, adding that data to the bottom.

It works fine, as long as there is something for each criteria.
If, however, one of the criteria is blank, it will take all 65536
rows, and paste those blank cells over.

Can i get the macro to not copy the cells if the criteria autofilter
is blank.
Or perhaps even a different way of copying the data, how it looks for
it?

If you can help, thankyou.

** Here is my macro...


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

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

*** and so on...

 

[NoodNutt]

G'day

I have always found less hassles by going to the last row then counting back
to the top.

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

I use this (although not pretty, yet effective) code.

Sub Split_Data()

Dim SourceSheet As Worksheet
Dim DestinationSheet As Worksheet
Dim rng As Range

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Sheets("NSW").Select

Set SourceSheet = Sheets("Data")
Set rng = SourceSheet.Range("A8:O" & Rows.Count)
Set DestinationSheet = Sheets("NSW")

SourceSheet.AutoFilterMode = False
rng.AutoFilter Field:=1, Criteria1:="=SYD"

SourceSheet.AutoFilter.Range.Copy
With DestinationSheet.Range("A5")
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Select
End With

Range("A4:O50").Select
Selection.Sort Key1:=Range("A4:A50"), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal

SourceSheet.AutoFilterMode = False
End Sub

HTH
Mark.