run macro on activeworkbook

Can any one adjust the code pasted below so that when I run the macro it will automatically run in the code against the contents of the active workbook rather than opening a chosen file for it to run on?

I believe you will need to change the bit of code in BOLD





Sub test()


Dim original_wb As Workbook
Dim new_wb As Workbook


Set original_wb = Workbooks.Open("P:\Supplier Relations\Current Supplier Info\Database\Rob\member email addresses as of (26.05.2015).xlsm") 'adjust file location

row_count = original_wb.Sheets(1).UsedRange.Rows.Count
col_count = original_wb.Sheets(1).UsedRange.Columns.Count

For i = 2 To row_count Step 1
   
    attachname = "THS_Direct_Trading_Terms_Contact_Details.xlsx"
    emailaddress = original_wb.Sheets(1).Cells(i, 20).Value 'email address from column B
    If emailaddress <> "" Then
        Set new_wb = Workbooks.Add
       
        original_wb.Sheets(1).Range("A1").EntireRow.Copy Destination:=new_wb.Sheets(1).Range("A1")
        original_wb.Sheets(1).Range("A" & i).EntireRow.Copy Destination:=new_wb.Sheets(1).Range("A2")
       
        Application.DisplayAlerts = False
        new_wb.SaveAs Environ("temp") & "\" & attachname
        new_wb.Close SaveChanges:=False
        Set new_wb = Nothing
        Application.DisplayAlerts = True
     
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
                .To = emailaddress
                .CC = ""
                .BCC = ""
                .Subject = "This is the Subject line" 'adjust subjectline!
                .Body = "Dear Supplier," & vbCrLf & vbCrLf & "Attached are the terms/details we hold on file for your current trading terms and contact details with THS direct. Please can you confirm these details are correct by placing a 1 in cell Z3." & vbCrLf & "If there are any differences please overwrite the current terms in red font." & vbCrLf & "Once confirmed please return the complete spreadsheet to rob.marr@thstools.co.uk" & vbCrLf & vbCrLf & "These terms will be incorporated into our THS Supplier Buying Agreement (SBA) which will subsequently be sent to yourselves to sign and return." & vbCrLf & vbCrLf & "Rob"
                .Attachments.Add (Environ("temp") & "\" & attachname)
                .Send
        End With
       
        Set OutMail = Nothing
        Set OutApp = Nothing
       
        Kill Environ("temp") & "\" & attachname
    End If
Next

End Sub
mikes6058Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Ingeborg Hawighorst (Microsoft MVP / EE MVE)Microsoft MVP ExcelCommented:
Hello,

have you tried

Dim original_wb As Workbook
Dim new_wb As Workbook


Set original_wb = ActiveWorkbook

Open in new window


cheers teylyn
0
mikes6058Author Commented:
yes I have but when I run the macro nothing happens.

please find attached for testing.

When you run the macro it should send "each" row and the column headings in a separated worksheet to the corresponding email address populated in column B.
member-email-addresses-2.xlsm
0
Saqib Husain, SyedEngineerCommented:
For the given file change

    emailaddress = original_wb.Sheets(1).Cells(i, 20).Value 'email address from column B

to

    emailaddress = original_wb.Sheets(1).Cells(i, 2).Value 'email address from column B
0
mikes6058Author Commented:
the point is that the macro is not running when I change

Set original_wb = Workbooks.Open("P:\Supplier Relations\Current Supplier Info\Database\Rob\member email addresses as of (26.05.2015).xlsm") 'adjust file location

to

Set original_wb = ActiveWorkbook
0
Saqib Husain, SyedEngineerCommented:
Yes it is running. The problem is that it is looking for email addresses in column 20 whereas the email addresses are in column 2 so the macro loops and does nothing else.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.