PDA

View Full Version : Copy Worksheet code needs to copy VALUES



tomsweddy
06-23-2009, 03:02 AM
Hi,

I have the following code which when the button is clicked it finds a worksheet in my workbook, copies it and then presents the user with an auto populated 'Save As' box for them to save.

Sub EmailLineManager()
Dim sSheetName As String
Dim Filename As Variant


On Error Resume Next
sSheetName = Application.VLookup(Range("K12").Value, Range("F119:G127"), 2, False)
On Error GoTo 0

If sSheetName <> "" Then

Filename = Range("E6").Value
Filename = Mid(Filename, InStr(Filename, " ") + 1) & " " & _
Left(Filename, InStr(Filename, " ") - 1) & _
", CONTRACT, " & Format(Range("K8").Value, "dd.mm.yy") & ".xls"
Filename = Application.GetSaveAsFilename(Filename, "Microsoft Excel Files (*.xls), *.xls")
If Filename <> False Then

Worksheets(sSheetName).Copy
ActiveWorkbook.SaveAs Filename
End If
Else
MsgBox "You have not selected a Contract Type", vbOKOnly + vbInformation, "Information"
End If



End Sub

However, when I open the newly saved worksheet I find that all the contents of it are linked back to the original workbook. Therefore I cant forward this worksheet on as it always requires access to the original workbook to display its info.

Therefore, is there anyway to alter this code so that when it copies the worksheet it copies the VALUES rather than the formulas etc.

Thanks alot for any help.

GTO
06-23-2009, 04:10 AM
Greetings Tom,

I did not attempt to follow your code directly, as the VLookup and assigning the new file's name you already have handled. Rather, this is just a simple example of another way to get the new one-sheet workbook to have only the values, rather than the formulas from the sent sheet.


Option Explicit

Sub SimpleEx()
Dim wksOrigin As Worksheet, wbNew As Workbook

With ThisWorkbook
'// Change sheet name (tab name) to suit //
.Worksheets("Sheet2").Copy , .Worksheets(.Worksheets.Count)
'// SAA //
Set wksOrigin = .Worksheets("Sheet2 (2)")

'// Change sheet's tab name to suit, here and below //
With wksOrigin
.UsedRange.Value = .UsedRange.Value
.Name = "Sent"
End With
End With

Set wbNew = Workbooks.Add(xlWorksheet)

With wbNew
'// Similar to above, shange path and name to suit //
.SaveAs ThisWorkbook.Path & "\Sent.xls"
ThisWorkbook.Worksheets("Sent").Move After:=Workbooks(.Name).Worksheets(1) ' After:=Workbooks("Sent.xls").Sheets(1)

Application.DisplayAlerts = False
.Worksheets(1).Delete
Application.DisplayAlerts = True
'// Save/Close new wb, or leave open and attach?
.Close True
End With
End Sub


Does that help?

Mark

tomsweddy
06-23-2009, 04:27 AM
Thanks, but how would I implement something like this in my code? the only part where I can see copying being undertaken in my code is this part below:

Worksheets(sSheetName).Copy
ActiveWorkbook.SaveAs FileName

Thanks for helping

GTO
06-23-2009, 05:06 AM
Thanks, but how would I implement something like this in my code? the only part where I can see copying being undertaken in my code is this part below:

Worksheets(sSheetName).Copy
ActiveWorkbook.SaveAs FileName

Thanks for helping

I agree, you are currently copying the worksheet (w/the formulas in it) to no destination, which creates a new one-sheet workbook. Then we are SaveAs'ing this new wb (yeah, that was terrible English), which means the formulas are in the new wb.

What I suggested was to copy the sheet first "in-house" (that is, to the origin wb), overwrite the formulas with the values, and then move the sheet to a new wb.

TOTALLY untested, so in a throwaway copy of your wb:


Option Explicit

Sub EmailLineManager()
Dim sSheetName As String
Dim Filename As Variant
Dim wksOrigin As Worksheet
Dim wbNew As Workbook

On Error Resume Next
sSheetName = Application.VLookup(Range("K12").Value, Range("F119:G127"), 2, False)
On Error GoTo 0

If sSheetName <> "" Then

Filename = Range("E6").Value

Filename = Mid(Filename, InStr(Filename, " ") + 1) & " " & _
Left(Filename, InStr(Filename, " ") - 1) & _
", CONTRACT, " & Format(Range("K8").Value, "dd.mm.yy") & ".xls"

Filename = Application.GetSaveAsFilename( _
Filename, "Microsoft Excel Files (*.xls), *.xls")

If Filename <> False Then
With ThisWorkbook
.Worksheets(sSheetName).Copy , .Worksheets(.Worksheets.Count)
Set wksOrigin = .Worksheets(sSheetName & " (2)")

With wksOrigin
.UsedRange.Value = .UsedRange.Value
.Name = "Sent"
End With
End With

Set wbNew = Workbooks.Add

With wbNew
.SaveAs Filename
ThisWorkbook.Worksheets("Sent").Move After:=Workbooks(.Name).Worksheets(1)
Application.DisplayAlerts = False
.Worksheets(1).Delete
Application.DisplayAlerts = True
'// Save/Close new wb, or leave open and attach?
.Close True
End With
End If
Else
MsgBox "You have not selected a Contract Type", vbOKOnly + vbInformation, "Information"
End If
End Sub


Does that make anymore sense?

You could of course copy the sheet to no destination/a new wb first, and then overwrite the formulas w/values. I simply prefer to have a reference already set to the new wb.

Hope that helps,

Mark

tomsweddy
06-23-2009, 05:17 AM
You could of course copy the sheet to no destination/a new wb first, and then overwrite the formulas w/values. I simply prefer to have a reference already set to the new wb.

I would prefer the no destination options as I dont want to meddle with the original copy with formulas in. Could you adopt the code for me to do this? THANKS!!!

tomsweddy
06-23-2009, 05:24 AM
THANKS A BUNCH GTO if you can tell me how to do this.?

GTO
06-23-2009, 06:03 AM
Hi Tom,

I am about beat as a bad huntin' dog, but I believe you altered your last post, as I swear is said akin to NM, could I rid the extra sheet and attach the new wb to an email.

Not sure what changed, but to clarify, we are not meddling w/the orig sheet. We are working w/a copy of it.

As to the new wb, this: Set wbNew = Workbooks.Add

Should be: Set wbNew = Workbooks.Add(xlWorksheet)

as shown in my first.

If the email is still a question, that will have to wait (for me leastwise) as this lad must hit the rack.

Presuming email at work, and some type of network/security/etc., I would start reading Chip Pearson's examples of CDO.

Hope that helps,

Mark

tomsweddy
06-23-2009, 06:13 AM
How do i get around it only copying 255 characters?

GTO
06-23-2009, 02:01 PM
How do i get around it only copying 255 characters?

Okay, let's try getting around the char limit by copying the cells rather than the sheet, and using PasteSpecial to plunk them in a newly created sheet.

Again, not tested, so in a copy of your wb...


Option Explicit

Sub EmailLineManager()
Dim sSheetName As String
Dim Filename As Variant
Dim wksOrigin As Worksheet
Dim wbNew As Workbook

On Error Resume Next
sSheetName = Application.VLookup(Range("K12").Value, Range("F119:G127"), 2, False)
On Error GoTo 0

If sSheetName <> "" Then

Filename = Range("E6").Value

Filename = Mid(Filename, InStr(Filename, " ") + 1) & " " & _
Left(Filename, InStr(Filename, " ") - 1) & _
", CONTRACT, " & Format(Range("K8").Value, "dd.mm.yy") & ".xls"

Filename = Application.GetSaveAsFilename( _
Filename, "Microsoft Excel Files (*.xls), *.xls")

If Filename <> False Then
With ThisWorkbook
'// To get around the 255 char limit, instead of copying the sheet,
'// I believe we can .Add a sheet, Copy the original range, and
'// use PasteSpecial.
Set wksOrigin = .Worksheets.Add(.Worksheets(1))
wksOrigin.Name = "Sent"
.Worksheets(sSheetName).UsedRange.Copy
wksOrigin.Range("A1").PasteSpecial xlPasteValues
wksOrigin.Range("A1").Select
Application.CutCopyMode = False
End With

Set wbNew = Workbooks.Add(xlWorksheet)

With wbNew
.SaveAs Filename
ThisWorkbook.Worksheets("Sent").Move After:=Workbooks(.Name).Worksheets(1)
Application.DisplayAlerts = False
.Worksheets(1).Delete
Application.DisplayAlerts = True
'// Save/Close new wb, or leave open and attach?
.Close True
End With
End If
Else
MsgBox "You have not selected a Contract Type", _
vbOKOnly + vbInformation, "Information"
End If
End Sub


Hope that helps,

Mark