URGENT!!! Problem with row data being truncated in a copy worksheet sub

  • Thread starter Thread starter DoctorV
  • Start date Start date
D

DoctorV

I have a sub that basically allows the user to e-mail a single sheet t
a client. It does alot of formatting and makes a temporary workboo
emails it then kills the file and returns them back to their mai
workbook when they are done.
:(
The problem is this part here. THIS I HAVE TO FIX. It is truncatin
rows that have more than 255 characters. If however i copy these row
highlight on a sheet the same range of rows and paste all of the dat
shows up. How can I adjust this one section so that all of the data i
the rows shows up not just 255 characters.

Range of rows on ActiveSheet is 1:298 Thanks
********************************
Part that needs to be fixed below here

With ActiveSheet.Copy

With ActiveSheet.Cells
.Copy
.PasteSpecial xlValues

End With

End With




***********************************
Entire Sub


Private Sub CommandButton2_Click()
'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 Shor
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).Sho
.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

End Su
 
Copy the sheet like you did.

But go back to the original sheet and do your copy of the cells.

then paste special to the new sheet.

option explicit
sub testme01()
dim oldWks as worksheet
dim newWks as worksheet

set oldwks = activesheet
oldwks.copy
set newwks = activesheet

oldwks.cells.copy
newwks.range("a1").pastespecial paste:=xlvalues

end sub
 
Back
Top