Hey
I am not very good in VBA and it took me a few months to get this resultat with a lot of help...
This macro is opening an email with the active sheet in where she is .
Here some explanation what does the macro do (because the input boxes are with French explanations) :
1. ask you to write an email (you need to write @ to continue)
2. ask you to write the name of the person to whom you send the email ("Dear X"). If you don't write anything it will be "Dear Mrs/Mr")
3. ask you to write some comments for the email body, if you want.
4. display the email with the active sheet (only range from A1 to column T, and until last filled row (but no less than row 18))
All is working very good until now.
I would like to add a feature that if I choose to add as attachment to the email a second worksheet (called "daily") the macro would add it in attachment .
But I really don't know what to change so as to make this change because presently this macro is only adding the active worksheet.
If someone knows what to do/how to do, and if it is not too much difficult, I would be happy for some help .
But if it is too much complicated and time consuming, so nevermind 
I join here the excel file.
Sub Mail_Range() ' SEND BY EMAIL RANGE FROM GENERAL
'Working in Excel 2000-2016
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 OutApp As Object
Dim OutMail As Object
Dim EmailAddress As String
Dim Remark As String
Dim agentname As String
Dim LastRow As Long
EmailAddress = InputBox("Veuillez entrer ci-dessous l'adresse email à laquelle vous souhaitez envoyer la rooming list. (L'hôtel recevra en pièce jointe les données contenues dans l'onglet général sans le PNR ni la remarque sur le règlement.)", "Adresse email")
If EmailAddress = "" Then
MsgBox "Vous devez préciser un email pour l'envoi. Action interrompue!", vbOKOnly, "Entrée invalide"
Exit Sub
Else
End If
If InStr(EmailAddress, "@") = 0 Then
MsgBox "Adresse email invalide. Action interrompue!", vbOKOnly, "Adresse invalide"
Exit Sub
Else
End If
agentname = InputBox("Veuillez entrer le prenom de l'hotelier.", "Nom hotelier")
If agentname = "" Then
agentname = "Mrs/Mr"
End If
Remark = InputBox("Veuillez entrer ci-dessous vos remarques, si vous en avez. Elles seront intégrées dans l'email. ATTENTION! Ne cliquez pas sur la touche ENTER pour aller à la ligne", "Remarques")
If Remark = "" Then
Remark = " "
Else
End If
msg = "Do you want to send to the hotel also a daily rooming list?"
Dialogstyle = vbQuestion + vbYesNo
Title = "Daily rooming list"
RESPONSE = MsgBox(msg, Dialogstyle, Title)
If RESPONSE = vbNo Then
End If
If RESPONSE = vbYes Then
MsgBox "here a macro which will save the other sheet called 'daily' and join it to this email attachment"
End If
Set Source = Nothing
ActiveSheet.Unprotect "obrat"
Columns("J").EntireColumn.Hidden = True
Columns("L").EntireColumn.Hidden = True
'copy from row 18 until last filled row (from column A to T)
LastRow = WorksheetFunction.Max(18, Range("B" & Rows.Count).End(xlUp).Row)
Set Source = Range("A1:T" & LastRow).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("B1") & " " & Range("C1")
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = EmailAddress
.Cc = ""
.BCC = ""
.Subject = Range("B1") & " " & Range("C1")
.body = "Dear" & " " & agentname & Chr(10) & Chr(10) & "Please find in attachment the rooming list." & Chr(10) & "Remarks:" & " " & Remark & Chr(10) & Chr(10) & "Best regards," & Chr(10) & Chr(10) & Application.UserName & " " & "-" & " " & "Obrat Tours"
.Attachments.Add Dest.FullName
.display
End With
.Close savechanges:=False
End With
'WRITE TIME
[W10] = Date
[W9] = EmailAddress
[W11] = Time
Kill TempFilePath & TempFileName & FileExtStr
CreateObject("WScript.Shell").Popup "Cette rooming list est prête à être envoyée. ", 2, " "
Set OutMail = Nothing
Set OutApp = Nothing
Columns("J").EntireColumn.Hidden = False
Columns("L").EntireColumn.Hidden = False
'WRITE TIME
[W10] = Date
[W9] = EmailAddress
[W11] = Time
ActiveSheet.Range("a1").Select
ActiveSheet.Protect Password:="obrat", DrawingObjects:=False, AllowFormattingCells:=True
ActiveWorkbook.Save
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub