Split Specific Sheets into New Excel Workbook and email to different people

[Excel2021]

Hello,

I have an Excel Workbook with 30 sheets and I would like to select specific sheets and turn them into new Workbooks which will then get sent out to specific people via email. Is this possible via VBA?


As an example, say I had a workbook with the following sheet names:

AppleUSD
AppleCAD
AppleGBP
OrangeUSD
OrangeCAD
OrangeGBP

I would like 2 seperate workbooks to be created automatically. 1) called "Apple" which would includes the 3 Apple sheets above and 2) called "Orange" which includes the 3 Orange sheets above.

if possible, next, I would like the newly created "Apple" Workbook to be sent with the email title "Apple" and the message saying "Please see the Attached file" to Bb@gmail.com and Ss@gmail.com. Similarly I would like the "Orange" workbook sent to PL@gmail.com and cc GD@gmail.com with the email title "Orange" and the message saying "Please see the Attached file".


Thanks in advance.

 

[Excel2021]

To make this simpler I would focus on the file splitting part first. I can always email these manually if I had to but the file splitting is definitely the most important step. There are lots of macros out there on how to split each sheet into a new file but I have not seen one which allow you to split 3 specific sheets into 1 file like I need.

 

[Trevor G]

Hi see if the following code is what your after. I've looked at creating the Apple one, you can duplicate it and change it for the Orange one.

ub CopyAppleSheetsAndEmail()
    Dim outlookApp As Object 'Used Object rather than setting reference to use Outlook version XX
    Dim outlookMail As Object 'Used Object to create the email
   
    'Copy Sheets To New Workbook
    Sheets(Array("AppleUSD", "AppleCAD", "AppleGBP")).Copy
    'Save new workbook, change the save location and file name
    ActiveWorkbook.SaveAs Filename:="C:\Users\Documents\Send Apple May 2024.xlsx" 'Change the file save location and file name
    'Close the new workbook
    ActiveWindow.Close
   
'Email Workbook
   
    ' Create a new instance of the Outlook app
    Set outlookApp = CreateObject("Outlook.Application")
   
    ' Create a new email item
    Set outlookMail = outlookApp.CreateItem(0)
   
    ' Configure the email
    With outlookMail
        .To = "Bb@gmail.com" & " Ss@gmail.com." ' Add the recipient's email address
        .CC = ""         ' Add CC email address (optional)
           ' Add BCC email address (optional)
        .Subject = "Apple"  ' Add your subject
        .Body = "Please see the Attached file"  ' Add the body of your email
        ' If you want to add an attachment (optional)
        .Attachments.Add "C:\Users\Documents\Send Apple May 2024.xlsx" 'Use the same location and file name as above.
        .Display   ' Display the email before sending as you might want to add extra info
        ' .Send    ' send the email without displaying
    End With
   
    ' Clean up
    Set outlookMail = Nothing
    Set outlookApp = Nothing
End Sub

 

[Excel2021]

Hi see if the following code is what your after. I've looked at creating the Apple one, you can duplicate it and change it for the Orange one.

ub CopyAppleSheetsAndEmail()
    Dim outlookApp As Object 'Used Object rather than setting reference to use Outlook version XX
    Dim outlookMail As Object 'Used Object to create the email
  
    'Copy Sheets To New Workbook
    Sheets(Array("AppleUSD", "AppleCAD", "AppleGBP")).Copy
    'Save new workbook, change the save location and file name
    ActiveWorkbook.SaveAs Filename:="C:\Users\Documents\Send Apple May 2024.xlsx" 'Change the file save location and file name
    'Close the new workbook
    ActiveWindow.Close
  
'Email Workbook
  
    ' Create a new instance of the Outlook app
    Set outlookApp = CreateObject("Outlook.Application")
  
    ' Create a new email item
    Set outlookMail = outlookApp.CreateItem(0)
  
    ' Configure the email
    With outlookMail
        .To = "Bb@gmail.com" & " Ss@gmail.com." ' Add the recipient's email address
        .CC = ""         ' Add CC email address (optional)
           ' Add BCC email address (optional)
        .Subject = "Apple"  ' Add your subject
        .Body = "Please see the Attached file"  ' Add the body of your email
        ' If you want to add an attachment (optional)
        .Attachments.Add "C:\Users\Documents\Send Apple May 2024.xlsx" 'Use the same location and file name as above.
        .Display   ' Display the email before sending as you might want to add extra info
        ' .Send    ' send the email without displaying
    End With
  
    ' Clean up
    Set outlookMail = Nothing
    Set outlookApp = Nothing
End Sub

I have tried the code to split the workbook and it works very well thanks. I am wondering if there is a way to make Excel do this process in the background rather than opening and closing the file to copy (so you don't see the gray screens)? Its not a big deal but since I will have to do this for 13 sheets or so it won't look the greatest visually.

Thanks.

 

[Trevor G]

You can switch the screen updating off but remember to switch it back on once it's run the procedure. Add this below the dim statements and before the sheets copy

 Application.ScreenUpdating=False

Then add this after the workbook.close

  Application.ScreenUpdating=True

 

[Excel2021]

You can switch the screen updating off but remember to switch it back on once it's run the procedure. Add this below the dim statements and before the sheets copy

 Application.ScreenUpdating=False

Then add this after the workbook.close

  Application.ScreenUpdating=True

Thanks for the help, I will try that. The email is working well also but I was wondering if I could add my signature to the bottom of the email as its not there currently (usually it would say my contact/title info). Also, to sent it without displaying do I just change the .Display to .Send? I believe that's what the instructions are implying.

Thanks.

 

[Trevor G]

You have to build the signature up within the email which means your have to change the body to use HTMLbody which basically will include formatting. An example is shown here. You would have to edit the text as necessary. Finally yes change the .Display to .Send. I would check it works first with the .Display and once happy change to .Send.

.HTMLBody = "<p> Hello, </p>" & _
                    "<p> Please see attachment. </p>" & _
                    "<p> Thank you, </p>" & _
                    "<p> Your signature details goes in here. </p>"

remove the " " from each line in the body as this is the way to display the HTML tags in this thread.

 

[jolivanes]

If you extend your amount of sheets, you'll have to manually change the code
This would not need that.

Sub Maybe()
Dim shArr
Dim snArr
Dim sh As Worksheet, currSh As Worksheet
Dim i As Long, j As Long
Set currSh = ActiveSheet
shArr = Array("Apple", "Orange", "Pear")    '<---- extend with as many as required
Application.ScreenUpdating = False
    For i = LBound(shArr) To UBound(shArr)
        For Each sh In ThisWorkbook.Worksheets
            If Left(sh.Name, Len(shArr(i))) = shArr(i) Then snArr = snArr & "|" & sh.Name
        Next sh
        snArr = Split(Mid(snArr, 2), "|")
        Sheets(snArr).Select
        ActiveWorkbook.Windows(1).SelectedSheets.Copy
    With ActiveWorkbook
        .SaveAs ThisWorkbook.Path & "\" & shArr(i) & " Sheets.xlsx", 51    'xlsm = 52
        .Close True
    End With
    snArr = ""
    Next i
currSh.Select
End Sub

 

[jolivanes]

You mentioned that you need to do this for 13 sheets. You can use this for as many sheets and workbooks as you want. All with one macro.
If you have the email addresses in Sheet2 in the first 13 columns (A to M) from the 2nd Row on down in the same order as the shArr items.
Cell A1 would have "Apple". From Cell A2 on down would be email addresses for the people that get the Apple Workbook emailed.
Cell B1 would have "Orange". From Cell B2 on down would be email addresses for the people that get the Orange Workbook emailed.
Cell C1 would have "Pear". From Cell C2 on down would be email addresses for the people that get the Pear Workbook emailed.
Continue like this for all email addresses and workbook names.
The following code will save the required workbooks to the same Folder where this Workbook is saved.
It will also email the workbooks to the required recipients.
Note: If a workbook exists with the same name in that same folder, it will be deleted and replaced by the new workbook.
Try it with using your own email address first to ensure that it gives you the needed amounts.

Sub One_Macro_For_All()
Dim shArr
Dim snArr
Dim sh As Worksheet, sh2 As Worksheet, currSh As Worksheet
Dim i As Long, j As Long, jj As Long
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set currSh = ActiveSheet
Set sh2 = Worksheets("Sheet2")
shArr = Array("Apple", "Orange", "Pear")    '<---- Sheet names start with this. extend with as many as required
jj = 1
Application.ScreenUpdating = False
    For i = LBound(shArr) To UBound(shArr)
        For Each sh In ThisWorkbook.Worksheets
            If Left(sh.Name, Len(shArr(i))) = shArr(i) Then snArr = snArr & "|" & sh.Name
        Next sh
        snArr = Split(Mid(snArr, 2), "|")
        Sheets(snArr).Select
        ActiveWorkbook.Windows(1).SelectedSheets.Copy
    With ActiveWorkbook
        If Dir(ThisWorkbook.Path & "\" & shArr(i) & " Sheets.xlsx") <> "" Then
            Kill ThisWorkbook.Path & "\" & shArr(i) & " Sheets.xlsx"
        End If
        .SaveAs ThisWorkbook.Path & "\" & shArr(i) & " Sheets.xlsx", 51    'xlsm = 52
        For j = 2 To sh2.Cells(sh2.Rows.Count, jj).End(xlUp).Row
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = sh2.Cells(j, jj).Value   
                .CC = ""
                .BCC = ""
                .Subject = "See " & ActiveWorkbook.Name     '"See Attached"
                .body = ""
                .Attachments.Add ActiveWorkbook.FullName
                .send
            End With
            DoEvents
            Next j
            j = 0
        .Close True
    End With
    snArr = ""
    jj = jj + 1
    Next i
currSh.Select
End Sub

 

[Excel2021]

You have to build the signature up within the email which means your have to change the body to use HTMLbody which basically will include formatting. An example is shown here. You would have to edit the text as necessary. Finally yes change the .Display to .Send. I would check it works first with the .Display and once happy change to .Send.

.HTMLBody = "<p> Hello, </p>" & _
                    "<p> Please see attachment. </p>" & _
                    "<p> Thank you, </p>" & _
                    "<p> Your signature details goes in here. </p>"

remove the " " from each line in the body as this is the way to display the HTML tags in this thread.

I was having difficulty doing this. I would have to insert my company's logo into the signature as well which is going to be tough. I will likely use the initial code you gave me and add the signatures manually through Outlook in the "display" view instead unless there is an easy way to accomplish this.