Sub
Tast()
Dim
arrC()
As
Variant
, x
As
Long
, y
As
Long
Application.ScreenUpdating =
False
With
Sheets(1)
y = .Cells.Find(
"*"
, .Cells(1), -4123, 2, 1, 2,
False
).Row
With
.Columns(3)
arrC = Range(.Cells(1), .Cells(y)).Value
End
With
y = 0
For
x = LBound(arrC, 1)
To
UBound(arrC, 1)
Select
Case
arrC(x, 1)
Case
1000
To
1100, 1200
To
1300, 1400
y = y + 1
.Rows(x).Copy Sheets(2).Cells(y, 1)
End
Select
Next
x
End
With
Application.ScreenUpdating =
True
End
Sub