Keep conditional formatting when selection is saved to a new file

[MrTinkertrain]

Hi all,

I'm currently working on a file which keeps track of a top 40-chartlist.
In cells E2-E41 I have the 40 hits of a particular week.
Through conditional formatting i've been able to highlight the new entries of that week
(yellow background, red cellcolour and bold font)
I've got a macro which saves my selection E2-E41 as a separate file.
The problem is that I want it to be saved with the conditional formatting mentioned above.
(Now my selection is saved with the default cell formatting)

Here's my code so far:

Sub CopySummary()
Application.ScreenUpdating = False
Dim MyCell As String
Dim MySaveRef As String
MyCell = Sheets("Inlezen nieuwe Top 40").Range("A49")
MySaveRef = "C:\Test\" & "week" & MyCell & ".xls"
Dim SourceBook As Workbook, DestBook As Workbook, DestSheet As Worksheet, _
ShCount As Integer, i As Integer
Set SourceBook = ThisWorkbook
Set DestBook = Workbooks.Add
ShCount = DestBook.Sheets.Count
Set DestSheet = DestBook.Worksheets.Add
SourceBook.Sheets("Inlezen nieuwe Top 40").Range("E2:E41").Copy
With DestSheet
.Range("A2").PasteSpecial Paste:=xlPasteValues
.Range("A2").PasteSpecial Paste:=xlPasteFormats
.Columns("A:E").ColumnWidth = 25
.Rows("2").RowHeight = 18
End With
Application.DisplayAlerts = False
For i = DestBook.Sheets.Count To DestBook.Sheets.Count - (ShCount - 1) Step -1
DestBook.Sheets(i).Delete
Next i
Application.DisplayAlerts = True
DestBook.SaveAs FileName:=MySaveRef
End Sub

I bet it's only one or two lines of extra code, but can't figure out what :S
Hope someone can help me out with this one

Thanx in advance

[Leith Ross]

Hello MrtinkerTrain,

Welcome to the Forum!

There are 2 options you can use.

With DestSheet
  .Range("A2").PasteSpecial Paste:=xlPasteValues
  .Range("A2").PasteSpecial Paste:=xlPasteFormats
  .Range("A2").PasteSpecial Paste:=xlPasteValidation
  .Columns("A:E").ColumnWidth = 25
  .Rows("2").RowHeight = 18
End With

Or if you don't need to restrict what is pasted...

Sub CopySummary()


  Dim MyCell As String
  Dim MySaveRef As String
  Dim SourceBook As Workbook, DestBook As Workbook, DestSheet As Worksheet, _
ShCount As Integer, i As Integer

  Application.ScreenUpdating = False
    MyCell = Sheets("Inlezen nieuwe Top 40").Range("A49")
    MySaveRef = "C:\Test\" & "week" & MyCell & ".xls"

    Set SourceBook = ThisWorkbook
    Set DestBook = Workbooks.Add
    ShCount = DestBook.Sheets.Count
    Set DestSheet = DestBook.Worksheets.Add

      SourceBook.Sheets("Inlezen nieuwe Top 40").Range("E2:E41").Copy _
       Destination:=DestSheet.Range("A2")

      With DestSheet
        .Columns("A:E").ColumnWidth = 25
        .Rows("2").RowHeight = 18
      End With

  Application.DisplayAlerts = False
    For i = DestBook.Sheets.Count To DestBook.Sheets.Count - (ShCount - 1) Step -1
      DestBook.Sheets(i).Delete
    Next i

  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  DestBook.SaveAs FileName:=MySaveRef

End Sub

Sincerely,
Leith Ross

[MrTinkertrain]

Thanx for your reply, Leith

I will give both of them a try and will give feedback of my results

Happy Easter by the way