VBA/Formula Help

[delone]

Hi, Need help with Excel. I have put together a spreadsheet for work, but stuck on one part, i am trying to do a formula/vba to send data to an email address.

A4:G10 Fixed Cells (Required everytime)
A11:G11 is the heading of a Table, which can go from 1 Row to 20 Rows depending on product. The Table will be at the bottom of the fixed cells.

What i need is a way of copying the Fixed cells and the table below and send it to an email address and a subject of Stock Check.

Would be grateful for any help

 

[Logit]

.
Paste these macros into a Routine Module :

Option Explicit




Sub mailTableWithGridLines()
Dim OutApp As Object
Dim OutMail As Object
Dim vInspector, GetInspector, wEditor As Variant
Dim lastRow As Long


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


With OutMail
    .To = "yo momma@nowhere.com"
    .CC = "xyz@anc.com"
    .BCC = "abc@xyz.com"
    .Subject = "Test"
    .Body = "Dear" & "Macro " & vbCrLf
    .Display
    Sheets("Sheet2").Activate
    Sheets("Sheet2").Select
    Sheets("Sheet2").UsedRange.Copy
    Set vInspector = OutMail.GetInspector
    Set wEditor = vInspector.WordEditor


    wEditor.Application.Selection.Start = Len(.Body)
    wEditor.Application.Selection.End = wEditor.Application.Selection.Start


    wEditor.Application.Selection.Paste


'.Display
End With
Sheets("Sheet2").UsedRange.Clear
Application.CutCopyMode = False
    Sheets("Sheet1").Activate
    Range("A1").Select
End Sub




Sub CopyColumnAtoG()
    Dim lastRow As Long


    Sheets("Sheet1").Range("A1:G10").Copy Destination:=Worksheets("Sheet2").Range("A1")
   
    lastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row


    ThisWorkbook.Worksheets(1).Range("B5:G" & lastRow).Copy


    ThisWorkbook.Worksheets(2).Range("A11:G" & lastRow).PasteSpecial xlPasteValues
    
    Application.CutCopyMode = False
    
    mailTableWithGridLines
    
End Sub