I'm copying a sheet to a new workbook and saving it.
There are 2 merged cells (B8 and B24) that contain uip to 1000 characters.
My sheet copies and saves fine (including removing buttons, keeping logos,
pasting values, protecting the sheet and removing copied VB code).

Just these two cells do not copy the full content and cut off at 255
characters. The text is visable on the orriginal (format is set to general)
and the original work books stays open at all times - (I know both these can
be possible causes)

Full code pasted below - Any help would be appreciated.

Sub Make_New_Book()

Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim sh As Worksheet

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Copy every sheet from the workbook with this macro
Set Sourcewb = ThisWorkbook

Sheets("Monitoring Template").Copy
'Set Destwb to the new workbook
Set Destwb = ActiveWorkbook

'Change all cells in the worksheet to values if you want
If Destwb.Sheets(1).ProtectContents = False Then
With Destwb.Sheets(1).UsedRange
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1).Select
End With
Application.CutCopyMode = False
End If

For Each sShape In ActiveSheet.Shapes
If sShape.Name < "LOGO" Then sShape.Delete
Next sShape


Destwb.VBProject.VBComponents(ActiveSheet.CodeName ).CodeModule.DeleteLines 1,
Destwb.VBProject.VBComponents(ActiveSheet.CodeName ).CodeModule.CountOfLines

'Save the new workbook and close it
ActiveSheet.Protect ("password")
ActiveWorkbook.SaveAs Filename:=Range("B31").Value
ActiveWorkbook.Close

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub