Excel VBA Code HELP - email active sheet plus 1 other

[bc320]

I have a document set up where each month I have to send a sheet via email to someone. I have the below code linked to a button that says "Email".

Prior to that button coming up, there is another that hides all other sheets.

This active sheet changes monthly (I have 12 different sheets)

I have to send one other sheet with that. This one is updated but is the same sheet every month. Is there a slight modification I can make to this code to include sheet72 (the one that does not change)?

I have found a slight modification to the below code that uses the sheet names (.Sheets(Array("Sheet1", "Sheet3")).Copy) But I don't want the same sheet emailed all the time and when I change "Sheet1" to ActiveSheet I get an error.

Current Email Code:


Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object


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


Set Sourcewb = ActiveWorkbook


'Copy the ActiveSheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook


'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2013
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With


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


'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = ActiveSheet.Range("C1").Value


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "VOC Report for the month of"
.Body = ""
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.display 'or use .Display
End With
On Error GoTo 0
.Close savechanges:=False
End With


'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr


Set OutMail = Nothing
Set OutApp = Nothing


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

[ValerieT]

'Copy the ActiveSheet to a new workbook
ActiveSheet.Copy
means your button "Mail" is in the relevant sheet

I suggest you copy/past the code into a new macro2, create a new button2 in your sheet72 and link it to the new macro2. Doing so you are sure not to interfer/ break with the existing one.


You must be sure your sheet72 has the exact same format, because for example
TempFileName = ActiveSheet.Range("C1").Value
means it takes value from C1 to create the name of the file