Hello Ron,

No, you gave me exactly what I needed. Thank's so much. I've been
working on this macro for quite a long time, yours is so much better,
i've incorporated your lines so that once it copies all the value it
creates a total for each coloumn that needs totalling. This is very
nice, just took me a little while to figure out which formual to use in
order to get a total to come up instead of the #REF!

My second question was is there a simpler way of getting the page print
formated other than the way that I have it done here.

Thanks.


Sub Copy_With_AdvancedFilter_To_Worksheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Dim Lrow2 As Long



Set ws1 = Sheets("Sheet1") '<<< Change

'Set ws1 = ActiveCell.CurrentRegion.Columns(KeyCol).Offset(1,
0).Cells

'Set ws1 = myArea.Resize(myArea.Rows.Count - 1, 1)
'Tip : Use a Dynamic range name,
http://www.contextures.com/xlNames01.html#Dynamic
'or a fixed range like Range("A1:H1200")
Set rng = ws1.Range("A1").CurrentRegion '<<< Change

With Application
CalcMode = .Calculation
..Calculation = xlCalculationManual
..ScreenUpdating = False
End With

With ws1
rng.Columns(1).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
'This example filter on the first column in the range (change
this if needed)
'You see that the last two columns of the worksheet are used to
make a Unique list
'and add the CriteriaRange.(you can't use this macro if you use
the columns)

Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
..Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & Lrow)
..Range("IU2").Value = cell.Value
Set WSNew = Sheets.Add
Printing
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & "
manually"
Err.CLEAR
End If
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False
WSNew.Columns.AutoFit
Lrow2 = .Cells(Rows.Count, "a").End(xlUp).Row
..Rows(Lrow2).Copy WSNew.Range("a" &
WSNew.UsedRange.Rows.Count + 2)
Next
..Columns("IU:IV").CLEAR
End With

With Application
..ScreenUpdating = True
..Calculation = CalcMode
End With
End Sub

Sub Printing()
'
' Printing Macro
' Macro recorded 10/3/2005 by Dejan Lukic
'

'
With ActiveSheet.PageSetup
..PrintTitleRows = "$1:$1"
..PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
..LeftHeader = ""
..CenterHeader = ""
..RightHeader = ""
..LeftFooter = "&F"
..CenterFooter = "&A"
..RightFooter = "&P OF &N"
..LeftMargin = Application.InchesToPoints(0.75)
..RightMargin = Application.InchesToPoints(0.75)
..TopMargin = Application.InchesToPoints(1)
..BottomMargin = Application.InchesToPoints(1)
..HeaderMargin = Application.InchesToPoints(0.5)
..FooterMargin = Application.InchesToPoints(0.5)
..PrintHeadings = False
..PrintGridlines = False
..PrintComments = xlPrintNoComments
..PrintQuality = 600
..CenterHorizontally = True
..CenterVertically = False
..Orientation = xlLandscape
..Draft = False
..PaperSize = xlPaperLetter
..FirstPageNumber = xlAutomatic
..Order = xlDownThenOver
..BlackAndWhite = False
..Zoom = False
..FitToPagesWide = 1
..FitToPagesTall = False
..PrintErrors = xlPrintErrorsDisplayed
End With
End Sub


--
windsor
------------------------------------------------------------------------
windsor's Profile: http://www.excelforum.com/member.php...o&userid=27849
View this thread: http://www.excelforum.com/showthread...hreadid=473581