Problem with paste formats

[Defclone]

Hi Im using a modell where I need to save around 40 sheets to the location of the workbook. The sheets should be saved as values and that works fine but I would also like to transfer the formats, and I cant get this to work. I pieced together a code, like I said the paste special formats dont seem to work.
Hope someone can help.

Here is my code so far

Sub SaveShtsAsBook()
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
Dim CopyRange As Excel.Range
Set CopyRange = ActiveSheet.Range("A1:E40")
MyFilePath$ = ActiveWorkbook.Path & "\" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' End With
On Error Resume Next '<< a folder exists
MkDir MyFilePath '<< create a folder
For N = 1 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveSheet.Name
CopyRange.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Cells.PasteSpecial Paste:=xlPasteFormats
.Name = SheetName
[I1].Select
End With
'save book in this folder
.SaveAs Filename:=MyFilePath _
& "\" & SheetName & ".xls"
.Close SaveChanges:=True
End With
.CutCopyMode = False
Next
End With
Sheet1.Activate
End Sub