cutting filtered criteria from the original worksheet

[grunschlange]

Good morning.

I use a monthly alphabetical list to show me the total number of active/closed/pending cases for each office each month. The list has 30000 rows. I import it to a worksheet called "Alpha". I am trying to make a file which will filter cases from that list that are coming due for review in the next 3 months (I will do this each month, so the 3 months will always change).

I have the following code which filters "Alpha" for certain data. In this example, I am filtering the list to show all "F" cases due for review in April 2011 for worker "135A", and pasting the cases on the "ABC" worksheet:

Sub test2()
'
' test2 Macro
'
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False


Sheets("Alpha").Select
Range("A1").Select
myMonth1 = Application.InputBox("Enter the first of the three review months (mm yy).")
mySheet1 = Format(myMonth1, "mmmm")
Sheets(3).Name = "F-" & mySheet1
Sheets(6).Name = mySheet1
Sheets(9).Name = "ABC-" & mySheet1
Sheets(12).Name = "N-" & mySheet1


Dim FilterRange As Range
Dim CopyRange As Range


Sheets("Alpha").Select
Range("A1").Select
Selection.Offset(1, 11).Range("A1").Select
Selection.Copy
Sheets(3).Select
Range("A1").Select
ActiveCell.Offset(rowOffset:=0, columnOffset:=2).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.Goto Reference:="R1C1"

'Month1
Sheets("Alpha").Select
Range("A1").Select
Set FilterRange = Range("H1:L30000") 'Header in row
Set CopyRange = Range("A1:L30000")
FilterRange.AutoFilter Field:=1, Criteria1:="135A"
FilterRange.AutoFilter Field:=2, Criteria1:="F"
FilterRange.AutoFilter Field:=5, Criteria1:=myMonth1
CopyRange.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets(9).Range("A3")
Application.CutCopyMode = False
Sheets("Alpha").Activate
Selection.AutoFilter
Application.Goto Reference:="R1C1"
Sheets(9).Select
Application.Goto Reference:="R1C1"
Cells.Find(What:="DMF", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Application.Goto Reference:="R1C1"


Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


This code works fine for copying and pasting. Is there any way, though, to modify the code to cut the filtered items from the "Alpha" sheet and paste them on the destination sheet?

Let me know if you need more information for this inquiry.
Thanks.

 

[Andrew Poulsom]

You can't cut a discontiguous range. So you will have to delete the viaible rows after your copy/paste.