I am trying to use VBA to do the following:
1) copy a specified range (for example A4:H72)
2) open a new worksheet and paste as values the range copied from step 1
3) email the newly created spreadsheet to an email address that is located in a specified cell in the original worksheet (for example T20)
I have a working code that sends the new worksheet to a hard-coded recipient as seen below but I need the email address to change without having to change the code. Please help!
Note, I cant take credit for the code below. I borrowed it so kudos to the original owner!
1) copy a specified range (for example A4:H72)
2) open a new worksheet and paste as values the range copied from step 1
3) email the newly created spreadsheet to an email address that is located in a specified cell in the original worksheet (for example T20)
I have a working code that sends the new worksheet to a hard-coded recipient as seen below but I need the email address to change without having to change the code. Please help!
Note, I cant take credit for the code below. I borrowed it so kudos to the original owner!
Code:
Sub Mail_Range()
'HARDCODED TO MAIL TO ONE PERSON
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 I As Long
Set Source = Nothing
On Error Resume Next
Set Source = Range("A4:h72").SpecialCells(xlCellTypeVisible)
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
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
TempFilePath = Environ$("temp") & "\"
TempFileName = "Range of " & wb.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
For I = 1 To 3
.SendMail "email address goes here", _
"This is the Subject line"
If Err.Number = 0 Then Exit For
Next I
On Error GoTo 0
.Close SaveChanges:=False
End With
'Delete the file you have send
' Kill TempFilePath & TempFileName & FileExtStr
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub