Selected Answer
Vergad
In your Module 7 sub Email_Sheet_Click, a single line
ActiveSheet.Range("D9").Value = "Tomta"
would change the code to suit but I note that the code isn't specific to the named sheet (it uses ActiveSheet. commands) which could lead to problems if run with another sheet active. I've added a new variable oWs and changed the code to replace ActiveSheet with oWs (see changes on bold below)
Note too that I've renamed the macro (and assigned that your red "Returner..." button).
Sub Email_Returner_Click()
Dim objOutlook As Object
Dim objMail As Object
Dim signature As String
Dim oWB As Workbook
Dim PDF_Filename As String
Dim pakkeListe As Range
Set oWB = ActiveWorkbook
Dim SerNum As Range
' make macro specific to workbook/ sheet
Dim oWs As Worksheet
Set oWs = oWB.Worksheets("PakkeListe")
'change Ny adresse to Tomta
oWs.Range("D9").Value = "Tomta"
Set SerNum = Worksheets("Oversiktsliste").Range("B4:B100")
For Each Cell In SerNum
If Cell.Value = oWs.Range("B10").Value Then
' ### set adresse first
Cell.Offset(0, 2) = oWs.Range("D9") ' > addresse
Cell.Offset(0, 8) = "Tidligere @ " & Cell.Offset(0, 2) & "; " & Cell.Offset(0, 8) ' + adresse> Kommentar
End If
Next Cell
Set pakkeListe = oWs.Range("A4:B49")
pakkeListe.ExportAsFixedFormat Type:=xlTypePDF, Filename:="https:\\brendstil.sharepoint.com\Server\Stillas\Heis\Pakkelister\" & Range("D9") & "," & Range("A10") & "," & Range("B10")
PDF_File = "https:\\brendstil.sharepoint.com\Server\Stillas\Heis\Pakkelister\" & Range("D9") & "," & Range("A10") & "," & Range("B10") & ".pdf"
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.Display
End With
signature = objMail.HTMLbody
With objMail
.To = oWs.Range("C80")
.Cc = oWs.Range("C81")
.Subject = "Pakkeliste heis"
.HTMLbody = "<font face=" & Chr(34) & "Calibri" & Chr(34) & " size=" & Chr(34) & 4 & Chr(34) & ">" & "Hei," & "<br> <br>" & "Denne leveres tilbake til tomta. Tell over delene og sammenlign med forrige pakkeliste" & "<br> <br>" & signature & "</font>"
.Attachments.Add PDF_File
.Save
.Display
End With
Set objOutlook = Nothing
Set objMail = Nothing
End Sub
then the macro will proceed to seek the serial number in worksheets "
Oversiktsliste", create/save a pdf and email (if that's what you want). I've removed Module 7 sub
FindSerial since the lines after the code extract above now correct "
Oversiktsliste".
Incidentally I notice that you have a macro called Email_Sheet_Click in modules 1, 3, 4, 5, 6 and 7. Presumably they are iterations but it's not good practice to have them all the same, especially if you want to call on fronm a sheet macro say (VBA wouldn't know which one you meant!). You said you use only 5 and 7 so I've removed the others.
Hope this helps.
