Macro to save a sheet from one workbook into a separate workbook and then email to a given address

[cwills]

Hi all

I have an excel workbook with about 20 individual sheets to keep track of work allocation for a number members of staff (currently 8 staff members but soon to raise to 12 - not that you care about that)

I need a macro to extract 2 of these sheets, save them as a new workbook and then email that new workbook to a set email address. I can then repeat this macro for each person either within the same macro or if performance would be better then an individual macro for each member of staff

Any thoughts?

Thank you

 

[mumps]

It can be done with one macro. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary). In order to attach the new file to the email, the macro will first have to save it. What is the full path to the folder where you want to save each new file? Will the same two sheets be sent to all staff or will they be two different sheets for each staff member. If different, there needs to be a way for the macro to identify which sheets go to which staff member.

 

[cwills]

It can be done with one macro. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary). In order to attach the new file to the email, the macro will first have to save it. What is the full path to the folder where you want to save each new file? Will the same two sheets be sent to all staff or will they be two different sheets for each staff member. If different, there needs to be a way for the macro to identify which sheets go to which staff member.

Hi Mumps

I've used wetransfer to send the file, it can be found at

Master 27082022.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

I have redacted or deleted sensitive info.

In essence, each member of staff has a tab at the bottom with their initials, Each person will need their sheet and the sheet named 300 events copied into a new workbook. All other sheets are used by me for populating the data into their sheets
This new workbook will then be saved to S:\Work Split\Indiviual sheets\2022, named as their initials and today's date. This individual workbook will then need to be sent to their individual email address.

Let me know if you need anything else and thank you for any help you can provide

 

[mumps]

I assume that each person's sheet is named using their initials. Is this correct? Are the individual email addresses listed somewhere on each person's sheet? If not, will the email addresses, subject and body be entered manually in each email or do you want the macro to do this? Will each person create his/her own email or will someone else create each email as needed on an individual basis or all at once? Sorry for all these questions but the answers will affect how the macro is designed.

 

[cwills]

I assume that each person's sheet is named using their initials. Is this correct? Are the individual email addresses listed somewhere on each person's sheet? If not, will the email addresses, subject and body be entered manually in each email or do you want the macro to do this? Will each person create his/her own email or will someone else create each email as needed on an individual basis or all at once? Sorry for all these questions but the answers will affect how the macro is designed.

1. Yes - each person named as the initials on the individual sheet
2. Currently the email address is not listed on the sheet, but can be if easier (if so it would be in I1)
3. Same for subject and body, could add these to J1 and K1 respectively to allow for personalised email messages
4. The emails will be created all at once upon completion of the lists

Thank you

 

[mumps]

This macro assumes you have the email address, subject and body in I1:K1 in each person's sheet.

Sub CreateEmails()
    Application.ScreenUpdating = False
    Dim sPath As String, OutApp As Object, OutMail As Object, shArr As Variant, ws As Worksheet
    sPath = "S:\Work Split\Indiviual sheets\2022\"
    shArr = Array("Work Split", "Commercial", "Ready - Not allocated", "Look up sheet", "Open surveys report - morning", "300 events", "Previous day brought forward", _
        "Awaiting Revisits", "Today allocation check", "Samples to be analysed")
    Set OutApp = CreateObject("Outlook.Application")
    For Each ws In Sheets
        If IsError(Application.Match(ws.Name, shArr, 0)) Then
            Sheets(Array(ws.Name, "300 Events")).Copy
            ActiveWorkbook.SaveAs Filename:=sPath & ws.Name & Format(Date, "yyyy-mm-dd") & ".xlsx", FileFormat:=51
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = ws.Range("I1")
                .Subject = ws.Range("J1")
                .HTMLBody = ws.Range("K1")
                .attachments.Add ActiveWorkbook.FullName
                ActiveWorkbook.Close False
                .Display
            End With
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

 

[cwills]

This macro assumes you have the email address, subject and body in I1:K1 in each person's sheet.

Sub CreateEmails()
    Application.ScreenUpdating = False
    Dim sPath As String, OutApp As Object, OutMail As Object, shArr As Variant, ws As Worksheet
    sPath = "S:\Work Split\Indiviual sheets\2022\"
    shArr = Array("Work Split", "Commercial", "Ready - Not allocated", "Look up sheet", "Open surveys report - morning", "300 events", "Previous day brought forward", _
        "Awaiting Revisits", "Today allocation check", "Samples to be analysed")
    Set OutApp = CreateObject("Outlook.Application")
    For Each ws In Sheets
        If IsError(Application.Match(ws.Name, shArr, 0)) Then
            Sheets(Array(ws.Name, "300 Events")).Copy
            ActiveWorkbook.SaveAs Filename:=sPath & ws.Name & Format(Date, "yyyy-mm-dd") & ".xlsx", FileFormat:=51
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = ws.Range("I1")
                .Subject = ws.Range("J1")
                .HTMLBody = ws.Range("K1")
                .attachments.Add ActiveWorkbook.FullName
                ActiveWorkbook.Close False
                .Display
            End With
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

Spot on, I've added the other sheets which I redacted from the example into the shArr line and all works perfectly on a test run, now to set everyone's emails up on the individual sheets. Thank you so much for your time and help here, much appreciated

 

[mumps]

You are very welcome.