I have not created this code, is rather copying different codes and putting it together.
I need to send via email a full sheet,including the design, and the dropdown list, the code I have now it works, but it sends the sheet raw, meaning only the information, no design or the drop down list. This is my code, can someone help me what I should change in order to have the full sheet:
Sub Mailtrail()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Mail
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub Mail()
Dim Today As String
Dim Row As Integer
Dim DSP As String
Dim Too As String
Dim PMAM As String
Dim i As Integer
Dim wb As Workbook
Dim outlookapp As Variant
Dim OutlookMailItem As Variant
Dim myAttachments As Variant
Dim Temp As String
Dim FileAttachement As String
Dim CountZBF As Integer
CountZBF = Sheets("ZBF1").Cells(Rows.Count, 2).End(xlUp).Row
Temp = GetTempFolder
PMAM = Sheets("Info").Cells(5, 2).Value
Today = Sheets("Info").Cells(1, 2).Text
FileAttachement = Temp & PMAM & " Zustellerbefragung " & Today & " " & DSP & ".xlsx"
Row = Worksheets("Info").Cells(Rows.Count, 8).End(xlUp).Row
For i = 1 To Row
DSP = Sheets("Info").Cells(i, 8).Value
Too = Sheets("Info").Cells(i, 9).Value
Sheets("ZBF1").Select
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$AM$" & CountZBF).AutoFilter Field:=2, Criteria1:="\*" & DSP & "\*"
Cells.Select
Selection.Copy
Set wb = Workbooks.Add
Range("A1").PasteSpecial xlPasteValues
wb.SaveAs FileAttachement, AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
wb.Close
Set outlookapp = CreateObject("outlook.application")
Set OutlookMailItem = outlookapp.CreateItem(0)
Set myAttachments = OutlookMailItem.Attachments
With OutlookMailItem
.To = Too
.CC = Sheets("Info").Cells(4, 14).Text
.Subject = PMAM & " Zustellerbefragung für " & DSP & " " & Today
.Body = "Hallo DSP" & Chr(13) & Chr(13) & "Im Anhang findet ihr eure Zustellerbefragung." & Chr(13) & Chr(13) & "Bitte sendet diese innerhalb von 6 h an ******@amazon.com" & Chr(13) & Chr(13) & "Viele Grüße" & Chr(13) & Chr(13) & "ORM-Team"
.Attachments.Add FileAttachement
.Send
End With
Kill (FileAttachement)
Next i
Sheets("ZBF1").Select
Rows("1:1").Select
Selection.AutoFilter
End Sub
Function GetTempFolder()
GetTempFolder = Environ("temp") & "\"
End Function