VBA - Change Sheet Name...

[JonesyUK]

Dear All,

Please assist:

I have the following Macro which sends an email attachment to a specified user. It works perfectly.

However, the Attachment's Sheet Name always defaults to "Sheet1".

Please can you help me to be able to specify a different name for the attachment's Sheet Name, eg. "Data" - instead of "Sheet1"??

Many Thanks,


Sub SendEmail()

'Declare Variables
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim EmailAddress As String
Dim EmailSubject As String
Dim FileName As String
Dim WkNo As Integer
Dim MyYear As Integer
Dim MyDate As Date

Dim wbConfig As Workbook
Dim wsConfig As Worksheet

Set wbConfig = ThisWorkbook
Set wsConfig = wbConfig.Worksheets("Data")

Set Source = Nothing
On Error Resume Next

'Warn if Site is Blank
If IsEmpty(ThisWorkbook.Worksheets("Data").Range("Site")) Then
MsgBox "Please Enter a Valid Site Name."
Exit Sub
End If

'Warn if Date is Blank
If IsEmpty(ThisWorkbook.Worksheets("Data").Range("Date")) Then
MsgBox "Please Enter a Valid Date."
Exit Sub
End If

'Set Data Source
Set Source = Range("MyRange")

On Error GoTo 0

If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, " & _
"please correct and try again.", vbOKOnly
Exit Sub
End If

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

Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)

Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With

FileName = ThisWorkbook.Worksheets("Definitions").Range("FileName").Value


TempFilePath = Environ$("temp") & "\"
TempFileName = FileName

' If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143

' Else
'You use Excel 2007
' FileExtStr = ".xlsx": FileFormatNum = 51
' End If

EmailAddress = ThisWorkbook.Worksheets("Definitions").Range("EmailAddress").Value
EmailSubject = ThisWorkbook.Worksheets("Definitions").Range("SubjectName").Value

With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
.SendMail EmailAddress, _
EmailSubject
On Error GoTo 0
.Close SaveChanges:=False
End With

'Clear Memory

Kill TempFilePath & TempFileName & FileExtStr

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

 

[VoG]

Try

With Dest.Sheets(1)
    .Name = "Data"
    .Cells(1).PasteSpecial Paste:=8
    .Cells(1).PasteSpecial Paste:=xlPasteValues
    .Cells(1).PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
End With

 

[JonesyUK]

Perfect, Thank You!