emp enters data and gets work list emailed

i've currently got an excel spreadsheet where employee's go and put there name and employee number and then highlight the selected work and it will be emailed to them.

what i really want is a box on sheet 1 where an employee can enter a number "50-500" and their employee number in another box and have their name updated to next amount requested and updated to the spreadsheet on sheet 2 in Cells D7 on.

the employee number would update starting at sheet 2 D7 and to find the next available empty data would be in column D and would end at a variable number in column D that would be updated in sheet 2 Cell C3

i want it to open and update excel and send it as an attachment. (mine's doing it now.)

there has to be a better way. so i'd really like someone who knows what they're doing to help the less fortunate out.
any help is greatly appreciated.

here's my macro.

Sub Mail_Range()

    Dim Source As Range
    Dim Dest As Workbook
    Dim Wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object
    
    Set Source = Nothing
    On Error Resume Next
    Set Source = ActiveSheet.Range
                    CurrentRegion.Select
                    Selection.Copy
    On Error GoTo 0
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False

    Set OutApp = CreateObject("Outlook.Application")

    Set Wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)

    
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "LVS assignment " & " " _
                 & Format(Now, "dd-mmm-yy")

    FileExtStr = ".xlsx": FileFormatNum = 51
   
    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
    
        Set OutMail = OutApp.CreateItem(0)
       
        With OutMail
            .To = Range("E1") & ("@XXXXX.com")
            .Subject = "XXX"
            .body = "Here's the you've selected to work"
            .attachments.Add (TempFilePath & TempFileName & FileExtStr)
            .send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
                
        .Close SaveChanges:=False
    End With

    Kill TempFilePath & TempFileName & FileExtStr

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End With
End Sub