Hi All,
I have a macro that I found on the net for copying a filtered selection and copying to a new sheet. Works great and thanks very much to the donor. I would like to alter it slightly so that it just clears the sheet called 'Interval tasks' instead of deleting it and creating a new one. Here is the code:
Sub Copy_With_AutoFilter1() 'This code filters the task list by the true statement that is the outcome of the
'calender time selected by the task resource userform. It then creates a new sheet
'called Interval Tasks
Dim WS As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim rng2 As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Name of the worksheet with the data
Set WS = Sheets("All Tasks") '<<< Change
'Set filter range : A1 is the top left cell of your filter range and
'the header of the first column, D is the last column in the filter range
Set rng = WS.Range("A1:U" & Rows.Count)
'Firstly, remove the AutoFilter
WS.AutoFilterMode = False
'Delete the sheet MyFilterResult if it exists
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Interval Tasks").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'This example filters on the first column in the range (change the field if needed)
'In this case the range starts in A so Field:=1 is column A, 2 = column B, ......
'Use "<>Netherlands" if you want the opposite
rng.AutoFilter Field:=21, Criteria1:="=True"
'if you want to filter on a cell value you can use this, use "<>" for the opposite
'This example uses the activecell value
'rng.AutoFilter Field:=1, Criteria1:="=" & ActiveCell.Value
'This will use the cell value from A2
'rng.AutoFilter Field:=1, Criteria1:="=" & WS.Range("A2").Value
'Add a new worksheet to copy the filter results in
Set WSNew = Worksheets.Add
WSNew.Name = "Interval Tasks"
WSNew.Move after:=ThisWorkbook.Sheets("Charts")
Call FormatIntervals
'Copy the visible data and use PasteSpecial to paste to the new worksheet
WS.AutoFilter.Range.Copy
With WSNew.Range("A2")
' Paste:=8 will copy the columnwidth in Excel 2000 and higher
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteFormulas
.Sort Key1:=Range("N2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.CutCopyMode = False
.Select
End With
'Close AutoFilter on original sheet
WS.AutoFilterMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Call SortandFilter
End Sub
I have had a couple fo attempts to do it but so far no luck. Can anyone help?
Many thanks,
JD
Bookmarks