Edit VBA code to add new attachment on Email

P

Persl

New Member
Joined
Jun 29, 2020
Messages
14
Office Version
  1. 365
Platform
  1. Windows
Good day

I have the below code which is working perfect on my file

the code now take a copy of Sheets("DAILY OPS REPORT8") and save it as ".pdf" and ".xlsx" then attach both on email and take a html body from Sheets("index"), then reset the form by clear the cells on ranges

I need to let the same code to add Sheets("Sheet 7") as a PDF attachment on the same email

VBA Code: 
Sub Acreatepdf()

Dim cel As Range
Dim cell As Range
Dim celll As Range
Dim cellll As Range
Dim celllll As Range
Dim cellllll As Range
Dim celllllll As Range
Dim cellllllll As Range
Dim EmailSubject As String, EmailSignature As String
Dim CurrentMonth As String, DestFolder As String, PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object
Dim NewWB As Workbook
Dim ActiveWS As Worksheet
Dim Qaroos As String
Qaroos = "WS8"

CurrentMonth = ""

Set ActiveWS = ActiveSheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
ActiveSheet.PageSetup.PrintArea = "Qpmr"

' *****************************************************

' *****     You Can Change These Variables    *********

    EmailSubject = [SubMG]   'Change this to change the subject of the email. The current month is added to end of subj line

    OpenPDFAfterCreating = False    'Change this if you want to open the PDF after creating it : TRUE or FALSE

    AlwaysOverwritePDF = False      'Change this if you always want to overwrite a PDF that already exists :TRUE or FALSE

    DisplayEmail = True 'Change this if you don't want to display the email before sending.  Note, you must have a TO email address specified for this to work

    Email_To = [toMG]   'Change this if you want to specify To email e.g. ActiveSheet.Range("H1") to get email from cell H1

    Email_CC = [CCMG]

    Email_BCC = ""

' ******************************************************

    'Prompt for file destination

    With Application.FileDialog(msoFileDialogFolderPicker)

        If .Show = True Then

            DestFolder = .SelectedItems(1)

        Else

            MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"

            Exit Sub

        End If

    End With

 

    'Current month/year stored in H6 (this is a merged cell)

    CurrentMonth = Mid(ActiveSheet.Range("H6").Value, InStr(1, ActiveSheet.Range("H6").Value, " ") + 1)

    'Create new PDF file name including path and file extension

    PDFFile = DestFolder & Application.PathSeparator & [TitMG] & ".pdf"

    'If the PDF already exists

    If Len(Dir(PDFFile)) > 0 Then

        If AlwaysOverwritePDF = False Then

            OverwritePDF = MsgBox(PDFFile & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbQuestion, "File Exists")
            On Error Resume Next
            'If you want to overwrite the file then delete the current one

            If OverwritePDF = vbYes Then
                Kill PDFFile
                Kill Replace(PDFFile, ".pdf", ".xlsx")

            Else
                MsgBox "OK then, if you don't overwrite the existing PDF, I can't continue." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
                Exit Sub
            End If
        Else
            On Error Resume Next
            Kill PDFFile
            Kill Replace(PDFFile, ".pdf", ".xlsx")
        End If
        If Err.Number <> 0 Then
            MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
            Exit Sub
        End If
    End If
    'Create the PDF

    ActiveWS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
    Set NewWB = Workbooks.Add
    ActiveWS.copy Before:=NewWB.Sheets(1)
    NewWB.SaveAs Replace(PDFFile, ".pdf", ".xlsx")
    NewWB.Close
    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    'Display email and specify To, Subject, etc

    With OutlookMail
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = [SubMG]
        .Attachments.Add PDFFile
        .Attachments.Add Replace(PDFFile, ".pdf", ".xlsx")
        .HTMLBody = RangetoHTML(Sheets("Index").Range("AE564:AT588"))
        .Display
Application.DisplayAlerts = True
Application.EnableEvents = True
If Err Then
      MsgBox "E-mail not created", vbExclamation
    Else
            MsgBox "E-mail successfully Created, You may display your Morning report from your Outlook for final check ... ", vbInformation
    End If
        If DisplayEmail = False Then
             If Sheets("Index").Range("AD561").Value = "Timer" Then
                Application.OnTime TimeValue("09:29:00"), Procedure:="MYcode"
                   Else
            End If
        End If
    End With
ActiveSheet.Unprotect Qaroos

If ActiveSheet.Range("Z3").Value = "S" Then

'Sheets("Histor").Range("C2", Range("C2").End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("EZ3"), Unique:=True
'Sheets("Histor").Range("EZ3", Range("EZ3").End(xlDown)).Sort Key1:=Range("Z4"), Order1:=xlAscending, Header:=xlNo

        

     For Each cel In Sheets("DAILY OPS REPORT8").Range("D17:D33")
        If cel.Value = "05:59" Then
            Sheets("DAILY OPS REPORT8").Range("AE9").copy
            Sheets("DAILY OPS REPORT8").Range("AG9").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AC10:AE10").copy
            Sheets("DAILY OPS REPORT8").Range("AF10:AH10").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AE11:AE15").copy
            Sheets("DAILY OPS REPORT8").Range("AG11:AG15").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("Ah16:Ah22").copy
            Sheets("DAILY OPS REPORT8").Range("AG16:AG22").PasteSpecial xlPasteValues
            Exit For
        End If
   Next cel
   For Each cell In Sheets("DAILY OPS REPORT8").Range("D66:D82")
        If cell.Value = "05:59" Then
            Sheets("DAILY OPS REPORT8").Range("AE58").copy
            Sheets("DAILY OPS REPORT8").Range("AG9").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AD59:AF59").copy
            Sheets("DAILY OPS REPORT8").Range("AF10:AH10").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AE60:AE71").copy
            Sheets("DAILY OPS REPORT8").Range("AG11:AG22").PasteSpecial xlPasteValues
            Exit For
        End If
    Next cell
        For Each celll In Sheets("DAILY OPS REPORT8").Range("D114:D130")
        If celll.Value = "05:59" Then
            Sheets("DAILY OPS REPORT8").Range("AE106").copy
            Sheets("DAILY OPS REPORT8").Range("AG9").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AD107:AF107").copy
            Sheets("DAILY OPS REPORT8").Range("AF10:AH10").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AE108:AE119").copy
            Sheets("DAILY OPS REPORT8").Range("AG11:AG22").PasteSpecial xlPasteValues
            Exit For
        End If
   Next celll
   For Each cellll In Sheets("DAILY OPS REPORT8").Range("D162:D178")
        If cellll.Value = "05:59" Then
            Sheets("DAILY OPS REPORT8").Range("AE154").copy
            Sheets("DAILY OPS REPORT8").Range("AG9").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AD155:AF155").copy
            Sheets("DAILY OPS REPORT8").Range("AF10:AH10").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AE156:AE167").copy
            Sheets("DAILY OPS REPORT8").Range("AG11:AG22").PasteSpecial xlPasteValues
            Exit For
        End If
    Next cellll
        For Each celllll In Sheets("DAILY OPS REPORT8").Range("D210:D226")
        If celllll.Value = "05:59" Then
            Sheets("DAILY OPS REPORT8").Range("AE202").copy
            Sheets("DAILY OPS REPORT8").Range("AG9").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AD203:AF203").copy
            Sheets("DAILY OPS REPORT8").Range("AF10:AH10").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AE204:AE215").copy
            Sheets("DAILY OPS REPORT8").Range("AG11:AG22").PasteSpecial xlPasteValues
            Exit For
        End If
   Next celllll
   For Each cellllll In Sheets("DAILY OPS REPORT8").Range("D257:D273")
        If cellllll.Value = "05:59" Then
            Sheets("DAILY OPS REPORT8").Range("AE249").copy
            Sheets("DAILY OPS REPORT8").Range("AG9").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AD250:AF250").copy
            Sheets("DAILY OPS REPORT8").Range("AF10:AH10").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AE251:AE262").copy
            Sheets("DAILY OPS REPORT8").Range("AG11:AG22").PasteSpecial xlPasteValues
            Exit For
        End If
    Next cellllll
        For Each celllllll In Sheets("DAILY OPS REPORT8").Range("D304:D320")
        If celllllll.Value = "05:59" Then
            Sheets("DAILY OPS REPORT8").Range("AE296").copy
            Sheets("DAILY OPS REPORT8").Range("AG9").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AD297:AF297").copy
            Sheets("DAILY OPS REPORT8").Range("AF10:AH10").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AE298:AE309").copy
            Sheets("DAILY OPS REPORT8").Range("AG11:AG22").PasteSpecial xlPasteValues
            Exit For
        End If
   Next celllllll
   For Each cellllllll In Sheets("DAILY OPS REPORT8").Range("D350:D366")
        If cellllllll.Value = "05:59" Then
            Sheets("DAILY OPS REPORT8").Range("AE342").copy
            Sheets("DAILY OPS REPORT8").Range("AG9").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AD343:AF343").copy
            Sheets("DAILY OPS REPORT8").Range("AF10:AH10").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AE344:AE355").copy
            Sheets("DAILY OPS REPORT8").Range("AG11:AG22").PasteSpecial xlPasteValues
            Exit For
        End If
    Next cellllllll

For Each Pr In ActiveSheet.Pictures
       If Not Intersect(Pr.TopLeftCell, Range("K17:V33,K66:V82,K114:V130,K161:V178,K210:V226,K257:V273,K304:V320,K350:V366")) Is Nothing Then
        Pr.Delete
       End If
    Next Pr
For Each Pr In ActiveSheet.Pictures
      If Not Intersect(Pr.BottomRightCell, Range("K17:V33,K66:V82,K114:V130,K161:V178,K210:V226,K257:V273,K304:V320,K350:V366")) Is Nothing Then
        Pr.Delete
       End If
    Next Pr

Sheets("Index").Range("F37").copy
Sheets("Index").Range("E37").PasteSpecial xlPasteValues
Sheets("Index").Range("F38").copy
Sheets("Index").Range("E38").PasteSpecial xlPasteValues
Sheets("DAILY OPS REPORT8").Range("C379").copy
Sheets("DAILY OPS REPORT8").Range("B10").PasteSpecial xlPasteValues
Sheets("DAILY OPS REPORT8").Range("C380").copy
Sheets("DAILY OPS REPORT8").Range("B11").PasteSpecial xlPasteValues
Application.CutCopyMode = False

ActiveSheet.Range("D3,D4,J4,D5,G5,J5,D6,G6,J6,D10,I10,L10,M10,M11,P10:P11,S10,I11,G14,B14:D14,O14:R14,S14,U14,W14,L10,D17:D33,J17:J33,K17:K33,L17:L33,B39:B41,M6:X6,U5:X5").Value = ""
ActiveSheet.Range("A3,A4,A5,A6,A10,A11,A14,A17:A33,A39:A41").RowHeight = 16
Sheets("DAILY OPS REPORT8").Range("H3").Value = False

ActiveSheet.Range("D52,D53,J53,D54,G54,J54,D55,G55,J55,D59,I59,L59,M59,M60,P59:P60,S59,I60,G63,B63:D63,O63:R63,S63,U63,W63,L59,D66:D82,J66:J82,K66:K82,L66:L82,B88:B90,M55:X55,U54:X54").Value = ""
ActiveSheet.Range("A52,A53,A54,A55,A59,A60,A63,A66:A82,A88:A90").RowHeight = 16
Sheets("DAILY OPS REPORT8").Range("H52").Value = False

ActiveSheet.Range("D100,D101,J101,D102,G102,J102,D103,G103,J103,D107,I107,L107,M107,M108,P107:P108,S107,I108,G111,B111:D111,O111:R111,S111,U111,W111,L107,D114:D130,J114:J130,K114:K130,L114:L130,B136:B138,M103:X103,U102:X102").Value = ""
ActiveSheet.Range("A100,A101,A102,A103,A107,A108,A111,A114:A130,A136:A138").RowHeight = 16
Sheets("DAILY OPS REPORT8").Range("H100").Value = False

ActiveSheet.Range("D148,D149,J149,D150,G150,J150,D151,G151,J151,D155,I155,L155,M155,M156,P155:P156,S155,I156,G159,B159:D159,O159:R159,S159,U159,W159,L155,D162:D178,J162:J178,K162:K178,L162:L178,B184:B186,M151:X151,U150:X150").Value = ""
ActiveSheet.Range("A148,A149,A150,A151,A155,A156,A159,A162:A178,A184:A186").RowHeight = 16
Sheets("DAILY OPS REPORT8").Range("H148").Value = False

ActiveSheet.Range("D196,D197,J197,D198,G198,J198,D199,G199,J199,D203,I203,L203,M203,M204,P203:P204,S203,I204,G207,B207:D207,O207:R207,S207,U207,W207,L203,D210:D226,J210:J226,K210:K226,L210:L226,B232:B234,M199:X199,U198:X198").Value = ""
ActiveSheet.Range("A196,A197,A198,A199,A203,A204,A207,A210:A226,A232:A234").RowHeight = 16
Sheets("DAILY OPS REPORT8").Range("H196").Value = False

ActiveSheet.Range("D243,D244,J244,D245,G245,J245,D246,G246,J246,D250,I250,L250,M250,M251,I251,G254,B254:D254,O254:R254,S254,U254,W254,L250,D257:D273,J257:J273,K257:K273,L257:L273,B279:B281,M246:X246,U245:X245").Value = ""
ActiveSheet.Range("A243,A244,A245,A246,A250,A251,A254,A257:A273,A279:A281").RowHeight = 16
Sheets("DAILY OPS REPORT8").Range("H243").Value = False

ActiveSheet.Range("D290,D291,J291,D292,G292,J292,D293,G293,J293,D297,I297,L297,M297,M298,P297:P298,S297,I298,G301,B301:D301,O301:R301,S301,U301,W301,L297,D304:D320,J304:J320,K304:K320,L304:L320,B326:B328,M293:X293,U292:X292").Value = ""
ActiveSheet.Range("A290,A291,A292,A293,A297,A298,A301,A304:A320,A326:A328").RowHeight = 16
Sheets("DAILY OPS REPORT8").Range("H290").Value = False

ActiveSheet.Range("D336,D337,J337,D338,G338,J338,D339,G339,J339,D343,I343,L343,M343,M344,P343:P344,S343,I344,G347,B347:D347,O347:R347,S347,U347,W347,L343,D350:D366,J350:J366,K350:K366,L350:L366,B372:B374,M339:X339,U338:X338").Value = ""
ActiveSheet.Range("A336,A337,A338,A339,A343,A344,A347,A350:A366,A372:A374").RowHeight = 16
Sheets("DAILY OPS REPORT8").Range("H336").Value = False

Sheets("DAILY OPS REPORT8").Range("AG9").copy
Sheets("DAILY OPS REPORT8").Range("D3").PasteSpecial xlPasteValues
Sheets("DAILY OPS REPORT8").Range("Af10:Ah10").copy
Sheets("DAILY OPS REPORT8").Range("B14").PasteSpecial xlPasteValues
Sheets("DAILY OPS REPORT8").Range("AG11").copy
Sheets("DAILY OPS REPORT8").Range("D4").PasteSpecial xlPasteValues
Sheets("DAILY OPS REPORT8").Range("AG12").copy
Sheets("DAILY OPS REPORT8").Range("D5").PasteSpecial xlPasteValues
Sheets("DAILY OPS REPORT8").Range("AG13").copy
Sheets("DAILY OPS REPORT8").Range("B10").PasteSpecial xlPasteValues
Sheets("DAILY OPS REPORT8").Range("AG14").copy
Sheets("DAILY OPS REPORT8").Range("B11").PasteSpecial xlPasteValues

ActiveSheet.Protect Qaroos, DrawingObjects:=False, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingRows:=True, _
    AllowFormattingColumns:=False, AllowInsertingColumns:=False, _
    AllowInsertingRows:=False, AllowInsertingHyperlinks:=False, _
    AllowDeletingColumns:=False, AllowDeletingRows:=False, _
    AllowSorting:=False, AllowFiltering:=False, AllowUsingPivotTables:=False
MsgBox (" " & ActiveSheet.Range("D1").Value & " Empty Morning report ready to use.")

 Else
 
     For Each cel In Sheets("DAILY OPS REPORT8").Range("D17:D33")
        If cel.Value = "05:59" Then
            Sheets("DAILY OPS REPORT8").Range("AE9").copy
            Sheets("DAILY OPS REPORT8").Range("AG9").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AC10:AE10").copy
            Sheets("DAILY OPS REPORT8").Range("AF10:AH10").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AE11:AE15").copy
            Sheets("DAILY OPS REPORT8").Range("AG11:AG15").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("Ah16:Ah22").copy
            Sheets("DAILY OPS REPORT8").Range("AG16:AG22").PasteSpecial xlPasteValues
            Exit For
        End If
   Next cel
   For Each cell In Sheets("DAILY OPS REPORT8").Range("D66:D82")
        If cell.Value = "05:59" Then
            Sheets("DAILY OPS REPORT8").Range("AE58").copy
            Sheets("DAILY OPS REPORT8").Range("AG9").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AD59:AF59").copy
            Sheets("DAILY OPS REPORT8").Range("AF10:AH10").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AE60:AE71").copy
            Sheets("DAILY OPS REPORT8").Range("AG11:AG22").PasteSpecial xlPasteValues
            Exit For
        End If
    Next cell
        For Each celll In Sheets("DAILY OPS REPORT8").Range("D114:D130")
        If celll.Value = "05:59" Then
            Sheets("DAILY OPS REPORT8").Range("AE106").copy
            Sheets("DAILY OPS REPORT8").Range("AG9").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AD107:AF107").copy
            Sheets("DAILY OPS REPORT8").Range("AF10:AH10").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AE108:AE119").copy
            Sheets("DAILY OPS REPORT8").Range("AG11:AG22").PasteSpecial xlPasteValues
            Exit For
        End If
   Next celll
   For Each cellll In Sheets("DAILY OPS REPORT8").Range("D162:D178")
        If cellll.Value = "05:59" Then
            Sheets("DAILY OPS REPORT8").Range("AE154").copy
            Sheets("DAILY OPS REPORT8").Range("AG9").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AD155:AF155").copy
            Sheets("DAILY OPS REPORT8").Range("AF10:AH10").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AE156:AE167").copy
            Sheets("DAILY OPS REPORT8").Range("AG11:AG22").PasteSpecial xlPasteValues
            Exit For
        End If
    Next cellll
        For Each celllll In Sheets("DAILY OPS REPORT8").Range("D210:D226")
        If celllll.Value = "05:59" Then
            Sheets("DAILY OPS REPORT8").Range("AE202").copy
            Sheets("DAILY OPS REPORT8").Range("AG9").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AD203:AF203").copy
            Sheets("DAILY OPS REPORT8").Range("AF10:AH10").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AE204:AE215").copy
            Sheets("DAILY OPS REPORT8").Range("AG11:AG22").PasteSpecial xlPasteValues
            Exit For
        End If
   Next celllll
   For Each cellllll In Sheets("DAILY OPS REPORT8").Range("D257:D273")
        If cellllll.Value = "05:59" Then
            Sheets("DAILY OPS REPORT8").Range("AE249").copy
            Sheets("DAILY OPS REPORT8").Range("AG9").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AD250:AF250").copy
            Sheets("DAILY OPS REPORT8").Range("AF10:AH10").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AE251:AE262").copy
            Sheets("DAILY OPS REPORT8").Range("AG11:AG22").PasteSpecial xlPasteValues
            Exit For
        End If
    Next cellllll
        For Each celllllll In Sheets("DAILY OPS REPORT8").Range("D304:D320")
        If celllllll.Value = "05:59" Then
            Sheets("DAILY OPS REPORT8").Range("AE296").copy
            Sheets("DAILY OPS REPORT8").Range("AG9").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AD297:AF297").copy
            Sheets("DAILY OPS REPORT8").Range("AF10:AH10").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AE298:AE309").copy
            Sheets("DAILY OPS REPORT8").Range("AG11:AG22").PasteSpecial xlPasteValues
            Exit For
        End If
   Next celllllll
   For Each cellllllll In Sheets("DAILY OPS REPORT8").Range("D350:D366")
        If cellllllll.Value = "05:59" Then
            Sheets("DAILY OPS REPORT8").Range("AE342").copy
            Sheets("DAILY OPS REPORT8").Range("AG9").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AD343:AF343").copy
            Sheets("DAILY OPS REPORT8").Range("AF10:AH10").PasteSpecial xlPasteValues
            Sheets("DAILY OPS REPORT8").Range("AE344:AE355").copy
            Sheets("DAILY OPS REPORT8").Range("AG11:AG22").PasteSpecial xlPasteValues
            Exit For
        End If
    Next cellllllll
 
Sheets("Index").Range("F37").copy
Sheets("Index").Range("E37").PasteSpecial xlPasteValues
Sheets("Index").Range("F38").copy
Sheets("Index").Range("E38").PasteSpecial xlPasteValues
Sheets("DAILY OPS REPORT8").Range("C379").copy
Sheets("DAILY OPS REPORT8").Range("B10").PasteSpecial xlPasteValues
Sheets("DAILY OPS REPORT8").Range("C380").copy
Sheets("DAILY OPS REPORT8").Range("B11").PasteSpecial xlPasteValues
Application.CutCopyMode = False


ActiveSheet.Range("D3,D4,J4,D5,G5,J5,D6,G6,J6,D10,I10,L10,M10,M11,P10:P11,S10,I11,G14,B14:D14,O14:R14,S14,U14,W14,L10,D17:D33,J17:J33,K17:K33,L17:L33,B39:B41,M6:X6,U5:X5").Value = ""
ActiveSheet.Range("A3,A4,A5,A6,A10,A11,A14,A17:A33,A39:A41").RowHeight = 16
Sheets("DAILY OPS REPORT8").Range("H3").Value = False

ActiveSheet.Range("D52,D53,J53,D54,G54,J54,D55,G55,J55,D59,I59,L59,M59,M60,P59:P60,S59,I60,G63,B63:D63,O63:R63,S63,U63,W63,L59,D66:D82,J66:J82,K66:K82,L66:L82,B88:B90,M55:X55,U54:X54").Value = ""
ActiveSheet.Range("A52,A53,A54,A55,A59,A60,A63,A66:A82,A88:A90").RowHeight = 16
Sheets("DAILY OPS REPORT8").Range("H52").Value = False

ActiveSheet.Range("D100,D101,J101,D102,G102,J102,D103,G103,J103,D107,I107,L107,M107,M108,P107:P108,S107,I108,G111,B111:D111,O111:R111,S111,U111,W111,L107,D114:D130,J114:J130,K114:K130,L114:L130,B136:B138,M103:X103,U102:X102").Value = ""
ActiveSheet.Range("A100,A101,A102,A103,A107,A108,A111,A114:A130,A136:A138").RowHeight = 16
Sheets("DAILY OPS REPORT8").Range("H100").Value = False

ActiveSheet.Range("D148,D149,J149,D150,G150,J150,D151,G151,J151,D155,I155,L155,M155,M156,P155:P156,S155,I156,G159,B159:D159,O159:R159,S159,U159,W159,L155,D162:D178,J162:J178,K162:K178,L162:L178,B184:B186,M151:X151,U150:X150").Value = ""
ActiveSheet.Range("A148,A149,A150,A151,A155,A156,A159,A162:A178,A184:A186").RowHeight = 16
Sheets("DAILY OPS REPORT8").Range("H148").Value = False

ActiveSheet.Range("D196,D197,J197,D198,G198,J198,D199,G199,J199,D203,I203,L203,M203,M204,P203:P204,S203,I204,G207,B207:D207,O207:R207,S207,U207,W207,L203,D210:D226,J210:J226,K210:K226,L210:L226,B232:B234,M199:X199,U198:X198").Value = ""
ActiveSheet.Range("A196,A197,A198,A199,A203,A204,A207,A210:A226,A232:A234").RowHeight = 16
Sheets("DAILY OPS REPORT8").Range("H196").Value = False

ActiveSheet.Range("D243,D244,J244,D245,G245,J245,D246,G246,J246,D250,I250,L250,M250,M251,I251,G254,B254:D254,O254:R254,S254,U254,W254,L250,D257:D273,J257:J273,K257:K273,L257:L273,B279:B281,M246:X246,U245:X245").Value = ""
ActiveSheet.Range("A243,A244,A245,A246,A250,A251,A254,A257:A273,A279:A281").RowHeight = 16
Sheets("DAILY OPS REPORT8").Range("H243").Value = False

ActiveSheet.Range("D290,D291,J291,D292,G292,J292,D293,G293,J293,D297,I297,L297,M297,M298,P297:P298,S297,I298,G301,B301:D301,O301:R301,S301,U301,W301,L297,D304:D320,J304:J320,K304:K320,L304:L320,B326:B328,M293:X293,U292:X292").Value = ""
ActiveSheet.Range("A290,A291,A292,A293,A297,A298,A301,A304:A320,A326:A328").RowHeight = 16
Sheets("DAILY OPS REPORT8").Range("H290").Value = False

ActiveSheet.Range("D336,D337,J337,D338,G338,J338,D339,G339,J339,D343,I343,L343,M343,M344,P343:P344,S343,I344,G347,B347:D347,O347:R347,S347,U347,W347,L343,D350:D366,J350:J366,K350:K366,L350:L366,B372:B374,M339:X339,U338:X338").Value = ""
ActiveSheet.Range("A336,A337,A338,A339,A343,A344,A347,A350:A366,A372:A374").RowHeight = 16
Sheets("DAILY OPS REPORT8").Range("H336").Value = False

Sheets("DAILY OPS REPORT8").Range("AG9").copy
Sheets("DAILY OPS REPORT8").Range("D3").PasteSpecial xlPasteValues
Sheets("DAILY OPS REPORT8").Range("Af10:Ah10").copy
Sheets("DAILY OPS REPORT8").Range("B14").PasteSpecial xlPasteValues
Sheets("DAILY OPS REPORT8").Range("AG11").copy
Sheets("DAILY OPS REPORT8").Range("D4").PasteSpecial xlPasteValues
Sheets("DAILY OPS REPORT8").Range("AG12").copy
Sheets("DAILY OPS REPORT8").Range("D5").PasteSpecial xlPasteValues
Sheets("DAILY OPS REPORT8").Range("AG13").copy
Sheets("DAILY OPS REPORT8").Range("B10").PasteSpecial xlPasteValues
Sheets("DAILY OPS REPORT8").Range("AG14").copy
Sheets("DAILY OPS REPORT8").Range("B11").PasteSpecial xlPasteValues
Sheets("DAILY OPS REPORT8").Range("F8:F9").copy
Sheets("DAILY OPS REPORT8").Range("D10:D11").PasteSpecial xlPasteValues
ActiveSheet.Protect Qaroos, DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingRows:=True
  
    Application.ScreenUpdating = True

MsgBox (" " & ActiveSheet.Range("D1").Value & " Empty Morning report ready to use")

End If




End Sub

 

Function RangetoHTML(Rng As Range)

' Working in Office 2000-2016

    Dim fso As Object

    Dim ts As Object

    Dim TempFile As String

    Dim TempWB As Workbook

 

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in

    Rng.copy

    Set TempWB = Workbooks.Add(1)

    With TempWB.Sheets(1)

        .Cells(1).PasteSpecial Paste:=8

        .Cells(1).PasteSpecial xlPasteValues, , False, False

        .Cells(1).PasteSpecial xlPasteFormats, , False, False

        .Cells(1).Select

        Application.CutCopyMode = False

        On Error Resume Next

        .DrawingObjects.Visible = True

        .DrawingObjects.Delete

        On Error GoTo 0

    End With

 

    'Publish the sheet to a htm file

With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)

        .Publish (True)

    End With

 

    'Read all data from the htm file into RangetoHTML

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

    RangetoHTML = ts.readall

    ts.Close

    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")

 

    'Close TempWB

    TempWB.Close savechanges:=False

 

    'Delete the htm file we used in this function

    Kill TempFile

 
    Set ts = Nothing

    Set fso = Nothing

    Set TempWB = Nothing

End Function
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Sort by date Sort by votes
May this reply will look stupit to, you, because probably I will not have understood the problem...
Anyway, is it not enough to trasform the code in a sub with a worksheet parameter called "sh" and change the declaration of the ActiveWS variable consequently?

Of course activesheet format and content and "Sheet7" format and content must be the same.
 
Upvote 0
As I tell there is no problem on the code.

I need the code to add another attachment on the same email
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Locked
  • Question
Edit VBA code to let it automatically create Folder
Replies
5
Views
469
RoryA
RoryA
Z
  • Question
Questions on VBA
Replies
5
Views
133
DanteAmor
DanteAmor
H
  • Question
VBA Speed up Copy and paste
Replies
3
Views
372
skillilea
S
Chris_010101
  • Solved
Simple VBA Code help
2
Replies
12
Views
500
Chris_010101
Chris_010101
S
  • Solved
VBA: Am I double-calling a Sub given nested If statements? Or other inefficiencies?
Replies
8
Views
250
dreid1011
dreid1011

Forum statistics

Threads
1,215,069
Messages
6,122,954
Members
449,095
Latest member
nmaske

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top