How To Save, Rename, and Send Multiple Sheets, As Separate Attachments In Outlook

[LukeOR]

Hey guys,
Let me start by saying thank you for helping. You guys amaze me with how some of this code can be written, so simple, yet complex, it is most definitely an art form. I have a very limited, self taught knowledge of VBA, but I will try my best to explain my problem, or what I would like to accomplish.

I will try to explain this the best I know how,

I have a workbook where on the main page I create data to add to 1 of 8 sheets. The sheets are called 1, 2, 3,....8 Each sheet is basically a single page to print containing data. I want to save each of the 8 sheets as a new workbook into a folder on my computer using a value from each sheet ( lets say cell A1 ) as the file name. I would also like to load those 8 separate attachments into Outlook to send to some recipients. I would prefer to have this all set up in one macro I could run from a button. I have been able to get parts of this working, but I am having trouble tying everything together in one spot. For example: I have been able to Save the 8 sheets into a folder with the correct new filenames. And using some other code I have been able to load a single attachment into outlook (but the file name of attachment was not correct). If It helps, I will show the pieces of code I have that are working. Thanks to everyone for any help on this matter, much appreciated.


In summary, I would like to,
-Save each sheet (1-8) as a new workbook into a folder using value of A1 on each sheet as the filename
-Load those 8 new workbooks as an attachment in Outlook email to send

Here are some pieces of code I have that are working,
The following loads a single sheet in outlook with the filename "TempRangeForEmail",
I have been unable to get multiple files to attach, or get the filenames right.

Sub SEND_TO_OUTLOOK() 
    'SENDS SINGLE SHEET AS ATTACHMENT IN OUTLOOK
'VARIABLES
    Dim OLApp As Outlook.Application
    Dim OLMail As Object
'SAVES TO NEW WORKBOOK
        Sheets("1").Copy
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\TempRangeForEmail.xlsx"
'STARTS OUTLOOK
    Set OLApp = New Outlook.Application
    Set OLMail = OLApp.CreateItem(0)
        OLApp.Session.Logon
    With OLMail
        .To = "WHOEVER.com"
        .CC = ""
        .BCC = ""
        .Subject = "LOADS INTO SUBJECT LINE CORRECTLY"
        .Body = "LOADS INTO BODY OF EMAIL CORRECTLY"""
        .Attachments.Add (ThisWorkbook.Path & "\TempRangeForEmail.xlsx")
        .Display
'CHANGE TO SEND ONCE WORKING
    End With
        ActiveWorkbook.Close SaveChanges:=True
        Kill ThisWorkbook.Path & "\TempRangeForEmail.xlsx"
'Memory Cleanup
    Set OLMail = Nothing
    Set OLApp = Nothing
End Sub

And this code will save each sheet correctly with the correct filename into folder but I am unsure how to load these into Outlook as attachments, Also my apologies, I realize this code is unneccesarily long, which again points to my limited knowledge of VBA. But it was working.
To further confuse i know I mentioned cell A1 above, but this will be shown as S33 below.

Sub SAVES_TO_FOLDER()  'SAVES SHEETS TO FOLDER AS NEW WORKBOOKS
    Application.ScreenUpdating = False
        Dim fName As String
    'SHEET 1
        fName = Sheets("1").Range("S33").Value
        Sheets("1").Copy
            With ActiveWorkbook
    'DESTINATION FOLDER
        .SaveAs "S:\MY FOLDERS LOCATION" & fName
        .Close
    End With
    'SHEET 2
        fName = Sheets("2").Range("S33").Value
        Sheets("2").Copy
            With ActiveWorkbook
    'DESTINATION FOLDER
        .SaveAs "S:\MY FOLDERS LOCATION" & fName
        .Close
    End With
    'SHEET 3
        fName = Sheets("3").Range("S33").Value
        Sheets("3").Copy
            With ActiveWorkbook
    'DESTINATION FOLDER
        .SaveAs "S:\MY FOLDERS LOCATION" & fName
        .Close
    End With
    'SHEET 4
        fName = Sheets("4").Range("S33").Value
        Sheets("4").Copy
            With ActiveWorkbook
    'DESTINATION FOLDER
        .SaveAs "S:\MY FOLDERS LOCATION" & fName
        .Close
    End With
    'SHEET 5
        fName = Sheets("5").Range("S33").Value
        Sheets("5").Copy
            With ActiveWorkbook
    'DESTINATION FOLDER
        .SaveAs "S:\MY FOLDERS LOCATION" & fName
        .Close
    End With
    'SHEET 6
        fName = Sheets("6").Range("S33").Value
        Sheets("6").Copy
            With ActiveWorkbook
    'DESTINATION FOLDER
        .SaveAs "S:\MY FOLDERS LOCATION" & fName
        .Close
    End With
    'SHEET 7
        fName = Sheets("7").Range("S33").Value
        Sheets("7").Copy
            With ActiveWorkbook
    'DESTINATION FOLDER
        .SaveAs "S:\MY FOLDERS LOCATION" & fName
        .Close
    End With
    'SHEET 8
        fName = Sheets("8").Range("S33").Value
        Sheets("8").Copy
            With ActiveWorkbook
    'DESTINATION FOLDER
        .SaveAs "S:\MY FOLDERS LOCATION" & fName
        .Close
    End With
    Application.CutCopyMode = False
End Sub

And versions I am using,
Microsoft® Outlook® for Microsoft 365 MSO (Version 2204 Build 16.0.15128.20158) 64-bit
Microsoft® Excel® for Microsoft 365 MSO (Version 2204 Build 16.0.15128.20158) 64-bit

Thank you all for your time