Select a Range based in a criteria, copy to a new workbook and attach in Outlook
Hi all,
I did a few modifications in a code that i found on the internet (i can't post the link because i don't have 5 posts yet, sorry) . The original code copy only the ActiveSheet of the Workbook, creates a temporary file and send it by e-mail using Outlook. My modifications included a check if any cells in the Range AL12:A1001 have the value "Error" and it returns an error message so the user can fill all the mandatory fields before sending the file by e-mail, and also i included in this code a protection for the temporary sheet to prevent that the user modify the file before sending the e-mail.
But I would like to know if it is possible to, instead of copying the entire sheet, to copy only a Range selected based on a Criteria. My idea is to select only the rows from the colums "A" to "AC", but only if the value on column "AM" of this row is "OK". This is de code that i have until now:
Code:
Sub Mail_ActiveSheet()
'Working in Excel 2000-2013
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
Dim myPassword As String
Dim sht As Worksheet
Dim mycell As Range
For Each mycell In ActiveSheet.Range("AL12:AL1001")
If mycell.Value = "Error" Then
Cancel = True
Response = MsgBox("Please enter a value in all mandatory fields for each filled line" & vbLf & ", check row " & mycell.Row & " in sheet " & ActiveSheet.Name, vbCritical, "Error!")
End If
Next mycell
If Cancel = True Then Exit Sub
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
FileExtStr = ".xlsm": FileFormatNum = 52
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
'insert protect sheet
myPassword = "test"
ActiveSheet.Protect Password:=myPassword
'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Create Position " & " " & Format(Now, "dd-mmm-yy h-mm-ss")
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 = "e-mail"
.Subject = "test"
.Body = "Hi there"
.Attachments.Add Destwb.FullName
.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
I did try to replace the line
to
Code:
ActiveSheet.Range("A11:AC12").Copy
only to test if it would copy only the selected areas, but then the code did a copy of the entire Workbook with all the sheets, and I'm not quite sure why.
Can anyone help to clarify how to copy only an range and if possible how to define this range following the criteria that i mentioned above?
Thanks in advance!
