Using the tab name as a workbook name with VBA

Question

I'm completely new to VBA, and I need some help with the following VBA code I found in Microsoft Office (I'm currently using Excel 2007). I want to know how to do three things:

1. Create a button which runs the code when clicked.
2. Save a temporary workbook file with the name of the active worksheet, NOT the source workbook's name.
3. Select all the email addresses in column K and insert them as the recipients of the email created in the code below.

Can someone give me a hand with this?

Sub Mail_ActiveSheet()

    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook
        ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    ' Determine the Excel version, and file extension and format.
    With Destwb
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "You answered NO in the security dialog."
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
    End With

    ' You can use the following statements to change all cells in the
   ' worksheet to values.
    '    With Destwb.Sheets(1).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '    Application.CutCopyMode = False

    ' Save the new workbook, mail, and then delete it.
    TempFilePath = Environ$("temp") & "\"
    TempFileName = " " & Sourcewb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")

    Set OutApp = CreateObject("Outlook.Application")

    Set OutMail = OutApp.CreateItem(0)

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
       ' Change the mail address and subject in the macro before
       ' running the procedure.
        With OutMail
            .To = "laragon2@its.jnj.com"
            .CC = ""
            .BCC = ""
            .Subject = "test"
            .Body = "test"
            .Attachments.Add Destwb.FullName
            .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

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

Answer 1

For 1. You can create a button under Developer Tab-->Controls Group --> insert , find a button and assign existing macro to it.

For 2. Change sourcewb.name --> activeSheet.name

For 3. (Assuming Column K, each cell contain one valid email address in each cell)

EDIT You can put the code below after the line :

Set Sourcewb = ActiveWorkbook

---

Dim recipients As String
Dim i As Long
Dim height as long

With ActiveSheet
    .Activate
    Height = .Cells(.Rows.Count, 11).End(xlUp).Row ' column k
    For i = 1 To Height
        If .Cells(i, 11).Value <> "" Then 'if that cell contains ONE email address
            recipients = recipients & ";" & .Cells(i, 11).Value 'append it
        End If

    Next i
    If Len(recipients) > 0 Then 'remove the first dummy ";"
        recipients = Mid(recipients, 2)
    End If


End With

And replace

With OutMail
            .To = "laragon2@its.jnj.com"

by

With OutMail
            .To = recipients

EDIT 2: To To change from .cells(i,11) to .cells(i,7) for all the 11

In VBA cells(ROW,COLUMN) syntax is used.

A = 1

B = 2

...

G = 7

K = 11th column and so on

You can also use the code below to replace the original parts

Dim recipients As String
Dim i As Long
Dim height As Long
Dim colNum As Long


With ActiveSheet
    .Activate
    colNum = .Columns("K").Column ' You can replace K to G <~~~~ Changes here
    height = .Cells(.Rows.Count, colNum).End(xlUp).Row   '<~~~~ Changes here
    For i = 1 To height
        If .Cells(i, 11).Value <> "" Then 'if that cell contains ONE email address
            recipients = recipients & ";" & .Cells(i, colNum).Value 'append it   '<~~~~ Changes here
        End If

    Next i
    If Len(recipients) > 0 Then 'remove the first dummy ";"
        recipients = Mid(recipients, 2)
    End If


End With