Firstly thanks to Ron for his macro - it helped me alot!!
Ron's macro: http://www.rondebruin.nl/copy5.htm
Using: "Create a new sheet for one unique value(AutoFilter)" - has helped me alot.
I now need to to modify the above macro to include:
1. Loop - so that I can autofilter all the months of the year into separate new sheets.
2. Totals - of each column to be calculated in each sheet.
So is this possible? I want to run the macro above and obtain 12 new sheets that would be named as the months of the year, and each sheet to have the totals of the cell content of each column calculated.
I am a complete newbie to this all, so any help will be much appreciated.
Tony
My code - modified version to my needs:
Sub Copy_With_AutoFilter1()
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 data
Set WS = Sheets("Income") '<<< Change
'Set filter range : A1 is the top left cell of your filter range and
'the header of the first column, S is the last column in the filter range
Set rng = WS.Range("A1:S" & Rows.Count)
'Firstly, remove the AutoFilter
WS.AutoFilterMode = False
'Delete the sheet MyFilterResult if it exists
On Error Resume Next
Application.DisplayAlerts = False
Sheets("JUN-07").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:=3, Criteria1:="=Jun-07"
'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 = "JUN-07"
'Copy the visible data and use PasteSpecial to paste to the new worksheet
WS.AutoFilter.Range.Copy
With WSNEW.Range("A1")
' Paste:=8 will copy the columnwidth in Excel 2000 and higher
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With
' 'If you want to delete the rows in WS that you copy, also use this
' With WS.AutoFilter.Range
' On Error Resume Next
' Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
' .SpecialCells(xlCellTypeVisible)
' On Error GoTo 0
' If Not rng2 Is Nothing Then rng2.EntireRow.Delete
' End With
'Close AutoFilter
WS.AutoFilterMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Bookmarks