Macro to create new sheets and e-mail them.

[Billy]

I'm on a mission to break up a bunch of data and get it e-mailed to the appropriate people for editing. I have data sorted by username in an Excel workbook. My idea is place each user's range into a new and separate workbook, then save each workbook with the username (cell A1 in each sheet), then e-mail each sheet. Can anyone tell me if this can be done, and if so, get me started in the right direction?
Any thoughts on this are appreciated.

[Ziggy]

This is what I would do.

1)I would recommend using "Named" cell references to ensure the correct data is transferred, especially if it is not in the same range everytime.

2) Record a macro like this...Open the source sheet copy the range(select named range if possible), Open a new sheet, Paste the data, do a "Save as"(whatever you want to call it) then close the sheet. Go back to the source sheet, copy the next range and follow the same steps again. when your finished with the last sheet(closed) stop your recording.

3) it's up to you how you want the macro to run I prefer to close.

4)Now go back and edit the Code, paste this code just before the "ActiveWindow.close" code for each of the different files you are sending.

This Code:


ActiveWorkbook.SendMail Recipients:="Your e-mail", Subject:="Goes Here", ReturnReceipt:=True
MsgBox "Your Request Has Been Sent", , "Title Goes Here"

It will send to each address you put in, the macro will overwrite the files each time

It should work (I tried )but it depends on your preferences (you could probably tie it to abutton on your source sheet)

Ziggy

[Dave Hawley]

Hi Billy

Try some code like this to get you started, it's not tested but should work. It assumes that the ranges you want to seperate are named and all begin with an "X". This saves using a lengthy Select Case or If Statement.

It also assumes the name you wish to call each sheet and Workbook created is in cell A1 of the sheet housing the named range.


Sub SeperateAndMail()
Dim nRange As Name
Dim strFileName As String
For Each nRange In ThisWorkbook.Names
If Left(nRange.Name, 1) = "X" Then

Sheets.Add().Name = nRange.Name

strFileName = Sheets(nRange.Parent.Name).Range("A1")

Range(nRange.Name).Copy Destination:= _
Sheets(nRange.Name).Range("A1")

Sheets(nRange.Name).Copy 'Creates one sheet Workbook
ActiveWorkbook.SaveAs strFileName
Application.Dialogs(xlDialogSendMail).Show
ActiveWorkbook.Close
End If
Next nRange
End Sub

[Billy]

Thanks to both of you! I'll give it a shot.