Copy Entire Workbook, save as sheet name with current date, hide all sheets except one, & attach to email

[Amo840812]

Good morning! I am looking for help with something I am trying to do with Excel. I have a workbook with multiple tabs. I have a macro on one sheet (called Team List) that will take the current workbook, save it to the user's desktop (not my specific desktop, it will be used by more than one person, but not meant to be a shared file) and automatically hide all other sheets except the desk coverage sheet on the new workbook. What I'm trying to do is I have a tab called Team list with my team and their contact info listed. On another sheet I have a list of work that needs to be sent out to the team for who is covering what items. I want to be able to click a button linked to the macro on the team list tab and have it copy and save the entire workbook as a new copy name Desk Coverage with today's day to the desktop. I also want all the sheets except desk coverage sheet to be hidden on the new workbook (it has info pulled from to other sheets which is why I don't just want to copy that one sheet only). I would like the original workbook to remain open and the new one to be closed. It would be amazing if I had one macro that could also generate the email and attach the new workbook directly to the email. Right now I have it separated into two macros, one to save the workbook (but I have to manually hide the other sheets, and it closes my original) and I have a macro that creates the email, but I have to manually attach it. Not even sure if I can combine them. If it's not possible to auto attach the new workbook with today's entered as the name, I am ok with using just "Desk Coverage" as the name, but it would be so much easier if I could include today's date. Then my team goes in and can either look at the whole list for the day or sort by their name only and complete their items.

I know it's a huge ask but I have been driving myself crazy trying to figure it out. I am not a VBA expert by any stretch of the imagination, I have done a lot with VBA, just not experienced and self/Google taught, so talk to me like I'm 5 please lol. I'm hesitant to upload a copy of the file as it does have my team's contact info on it and I do not want to share that publicly. I am uploading a blacked-out screenshot of both the team list and desk coverage sheets.

Here is my wish list:
•Save current workbook as a NEW workbook.
•Hide all tabs except the tab called "Desk Coverage"
•Name it as "Desk Coverage MM/DD/YYYY" (current date)
•Save it to the user's desktop (not mine specifically, I have a back-up that will need to use this as well)
•Keep the original workbook open, while closing the new workbook (or not opening it all is fine too) OR one macro that will also create an Outlook email (to line is on sheet called "Email" cell C1, CC line is on "Email" cell C2, subject is on "Email, cell C3, and email body is on "Email" cells C5:C15. I would like to manual send it once the email is created (not auto send).

 

[DanteAmor]

Welcome to the MrExcel forum. Please accept my warmest greetings.

I think I have your entire wish list covered, but if I missed any details, let me know and I'll review it.

Put the folowing code in your book and try.
Note: The date in the file name must be mm-dd-yyyy with "-", because "/" is not allowed.

Sub save_copy_and_send_email()
  Dim newName As String, sDesk As String, sBody As String
  Dim wb As Workbook
  Dim sh As Worksheet, shE As Worksheet
  Dim OutMail As Object
  Dim i As Long
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  'set workbook name
  Const cName = "Desk Coverage"
  sDesk = CreateObject("WScript.Shell").specialfolders("Desktop")
  newName = sDesk & "\" & cName & " " & Format(Date, "mm-dd-yyyy") & ".xlsx"
  
  'copy and save workbook
  ThisWorkbook.Sheets.Copy
  Set wb = ActiveWorkbook
  For Each sh In wb.Sheets
    If LCase(sh.Name) <> LCase(cName) Then
      sh.Visible = xlSheetHidden
    End If
  Next
  wb.SaveAs newName, FileFormat:=xlOpenXMLWorkbook
  wb.Close False
  
  'email workbook
  Set shE = Sheets("Email")
  Set OutMail = CreateObject("Outlook.Application").CreateItem(0)
  With OutMail
    .To = shE.Range("C1").Value
    .Cc = shE.Range("C2").Value
    .Subject = shE.Range("C3").Value
    For i = 5 To 15
      sBody = sBody & shE.Range("C" & i).Value & vbCr
    Next
    .Body = sBody
    .Attachments.Add newName
    .Display
  End With
  
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

 

[Amo840812]

Thank you!!! That works amazingly!! You are the best!