Urgent Excel Copy Worksheet method is truncating data

[DoctorV3774]

I have an application used by 55 users. In the final step they are asked to e-mail the sheet they are on to an individual. What happens during the execution of this code is that it sends one sheet of just values to a user, stripping away all named ranges except the Print rane and removing all VBA. Everything works fine except that during the copy worksheet it truncates any merged cell with over 255 characters. The whole sub works ggreat except for this one critical area. It kills the file after the e-mail dow=es great stuff BUT I HAVE TO SOLVE THIS TRUNCATION. If I merely highlight the wholw sheet and copy it to a new sheet it takes all the data but of course then it loses the formatting. I need to do something like that but maintain the formatting. Please help this is an urgent problem. Thanks Code below

************************************
'You must add a reference to the Microsoft outlook Library
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Do you want to E-Mail this Quote Letter?" ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "Warning" ' Define title.
Help = "DEMO.HLP" ' Define Help file.
Ctxt = 1000 ' Define topic
' context.
' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
On Error GoTo err_showSendDialog
If Response = vbYes Then ' User chose Yes.
Application.ScreenUpdating = False
'Dim OutApp As Outlook.Application
'Dim OutMail As Outlook.MailItem
Dim wb As Workbook
Dim strdate As String
Dim Sub_ID As String
Sub_ID = ActiveSheet.Range("a6").Value
strdate = Format(Now, "Medium Date")
ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False

With ActiveSheet.Copy

With ActiveSheet.Cells
.Copy
.PasteSpecial xlValues

End With

End With
Application.Run ("FinalShortCleanup")
Set wb = ActiveWorkbook
'Code to remove all Named Ranges and VBA upon creation of Final Short Quote
With wb
.ActiveSheet.Shapes("CommandButton1").Delete
.ActiveSheet.Shapes("CommandButton2").Delete
.ActiveSheet.Shapes("CommandButton3").Delete
.ActiveSheet.Shapes("CommandButton4").Delete
.ActiveSheet.Shapes("cmdSendBut").Delete
Call Del(Application.Workbooks(ActiveWorkbook.Name))
Call DeleteAllVBA
.SaveAs "EMailSubmission_" & Sub_ID & "_" & strdate & ".xls"
Application.MailLogon ("AFGDefault")
Application.Dialogs(xlDialogSendMail).Show .ActiveSheet.Range("b12").Value
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False

End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Application.ScreenUpdating = True
'Set OutMail = Nothing
'Set OutApp = Nothing

'Set OutApp = Nothing

SetFocus FindWindow(vbNullString, Application.Caption)
Sheets("Quote_Info").Select
Range("j2").Activate

Else ' User chose No.

DoCmd.CancelEvent
End If

exit_showSendDialog:
Exit Sub

err_showSendDialog:
If Err.Number = 2501 Then 'User Cancelled DoCmd
Resume exit_showSendDialog
Else 'Add your own error handling routine here
Resume exit_showSendDialog
Resume Next
End If

*********************************************

 

[KenWright]

Have the code copy the worksheet to get all the formatting albeit you lose in excess of 255 characters in any cell, but then copy all the original sheets data and paste special as values into your new sheet and you will get all the data into your already formatted cells.

Regards
Ken............

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission

----------------------------------------------------------------------------

 

[KenWright]

You might also be interested in Ron De Bruins sendmail addin which does this too, and he has all the code open and commented on his website:-

http://www.rondebruin.nl/

Regards
Ken...............

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission

----------------------------------------------------------------------------

 

[xlbo]

Dammit Ken - just spent 15 mins testing that and finding the add-in. D'OH!

Rgds, Geoff

"Three things are certain: Death, taxes and lost data. Guess which has occurred"

Please read FAQ222-2244 before you ask a question

 

[DoctorV3774]

Ken, the send sheet method in his download gives the same problems as before it is truncating all data > 255 characters

 

[GlennUK]

If you move a sheet instead of copying it you won't get the truncation problem. Just remember not to save the source workbook after you've done that.



Cheers, Glenn.

Did you hear about the literalist show-jumper? He broke his nose jumping against the clock.

 

[KenWright]

Sorry, hadn't meant look at Ron's site specifically for that - it was more for a whole bunch of examples od sendmail type code.

Did you try what I suggested earlier. You would normally copy the worksheet which gives you all the formatting but truncates, and then copy the cells which gives you all the data, eg

Sub Copyme()

Dim curwks As Worksheet
Set curwks = Worksheets("sheet1")

With curwks
.Copy
.Cells.Copy Destination:=ActiveSheet.Range("A1")
End With

End Sub

Regards
Ken............



----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission

----------------------------------------------------------------------------

 

[KenWright]

LOL - Been there Geoff, usually just before I see you've posted an answer

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission

----------------------------------------------------------------------------

 

[xlbo]

LOL - fair dos - I'm sure Mr Loomah has a similar opinion as well !

Rgds, Geoff

"Three things are certain: Death, taxes and lost data. Guess which has occurred"

Please read FAQ222-2244 before you ask a question

 

[DoctorV3774]

Glenn If I move the sheet how can I have it be part of an e-mail in the event above

 

[KenWright]

I think Glenn meant you to move the sheet to a new book, copy and paste to hardwire the values (Or Edit / Links / Break Links if available), and then close the original book without saving.

Does the .cells.copy and paste bit not work for you for some reason?

Regards
Ken.............

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission

----------------------------------------------------------------------------

 

[DoctorV3774]

Ken,
I agree with you about moving the sheet but I am not sure how to do it in the code above. If as the code show we set a placeholder for wb as a temporary workbook how do I move the Activesheet to wb?

Then I could get rid of the code below and break the links like you were saying.

With ActiveSheet.Copy

With ActiveSheet.Cells
.Copy
.PasteSpecial xlValues

End With

 

[xlbo]

Don't need an active wb
Easiest way is:

Set tWb = Thisworkbook
[COLOR=green]'Sets reference to master workbook for further manipulation etc[/color]
Sheets("Sheet_Name").copy  
[COLOR=green]'This creates a COPY of the sheet in a NEW workbook[/color]
Set newWb = activeworkbook 
[COLOR=green]'Sets reference to newly created workbook for further manipulation / pasting etc[/color]
[COLOR=green]'You other code goes here, using tWb and / or newWb to differentiate between the workbooks[/color]

Rgds, Geoff

"Three things are certain: Death, taxes and lost data. Guess which has occurred"

Please read FAQ222-2244 before you ask a question