Udfordring med at sende med VBA

Hej Excel hjælpere.
Jeg har en udfordring.
Jeg har et ark jeg bestiller vare i, når jeg skal sende bestillingen laver Excel den fra fire til et fanebladet,
Og navngiver det også som den skal.  Så langt så godt.

Når jeg vil sende skal Excel kun sende den fil der lige er lavet, men Excel sender hele filen.
Også med en VBA-kode.
Nogle der kan hjælpe.

Hilsen Klaus W 

Sub MM1()


Application.ScreenUpdating = False
'----------/Døber variable/--------------'
Dim CopyWb As Workbook, PasteWB As Workbook
Dim CopyWS As Worksheet, PasteWS As Worksheet
Dim NameCell As Range
Dim Name As String
'----------/Tildeler variable indhold/--------------'
Set CopyWb = ThisWorkbook
Set CopyWS = CopyWb.Sheets("Bestilling")
Set NameCell = CopyWS.Range("G2")
Set PasteWB = Workbooks.Add
Set PasteWS = PasteWB.Sheets(1)
Name = NameCell.Value
'----------/Navngiver ark 1/--------------'
PasteWS.Name = CopyWS.Name
'----------/Tager en kopi af cellerne i "bestilling"/--------------'
CopyWS.Cells.Copy
'----------/formaterer og overfører data til det nye ark/--------------'
PasteWS.Cells.PasteSpecial xlPasteValues
PasteWS.Cells.PasteSpecial xlPasteFormats
PasteWS.Rows("9").Select
ActiveWindow.FreezePanes = True
PasteWS.Range("A1").Select
Application.CutCopyMode = False
'----------//--------------'
Application.ScreenUpdating = True

Application.Dialogs(xlDialogSaveAs).Show Name, 51
 
Hide_Gridlines

End Sub

Sub Hide_Gridlines()

Dim ws As Worksheet
Set ws = Worksheets("Bestilling")
'hide gridlines in a worksheet named Sheet2
ws.Activate
ActiveWindow.DisplayGridlines = False

Msgbox_BeforeRunning

End Sub


Sub Msgbox_BeforeRunning()

Worksheets("Bestilling").Unprotect

  Dim answer As Integer
  answer = MsgBox("Ønsker du at sende bestillingen ?", vbQuestion + vbYesNo)
 
If answer = vbNo Then ActiveWorkbook.Close savechanges:=True
 
  Worksheets("Bestilling").Protect
 
 
Sheets("Bestilling").Select
  Mail_workbook_Outlook

 
 
End Sub

Sub Mail_workbook_Outlook()
'her er koden til at sende mail
    Dim Edress As String, Subj As String
    Dim OutlookOBJ As Object, mItem As Object
    '---------------------------------------------'
    Set OutlookOBJ = CreateObject("Outlook.Application")
    Set mItem = OutlookOBJ.CreateItem(olMailItem)
    With mItem
   
        .To = Sheets("Bestilling").Range("g3").Value & "; " & Range("h4").Value & "; " & Range("h5").Value
        .CC = ""
        .BCC = ""
        .Subject = Sheets("Bestilling").Range("g2").Value
       
        .Body = Range("j1").Value & vbNewLine & vbNewLine & Range("j4").Value & vbNewLine & _
        Range("j5").Value & vbNewLine & Range("j6").Value & vbNewLine & Range("j7").Value & vbNewLine & _
        Range("j8").Value
       
        '.Send                              '<-- .Send will auto send email without review
                               
ThisWorkbook.Save
        .Attachments.Add ThisWorkbook.Path & "\" & ThisWorkbook.Name
        .Send
    End With

End Sub