Select a Range based in a criteria, copy to a new workbook and attach in Outlook

[dmarchina]

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:

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

ActiveSheet.Copy

to

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!

[Kenneth Hobs]

Try SpecialCells. e.g. http://www.vbaexpress.com/kb/getarticle.php?kb_id=786