Help To Divide Up an Excel Spreadsheet into lots of other Ones

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Noggy1

Thread Starter
Joined
Jan 29, 2005
Messages
51
Hi,

Is there anyone who can help with this little problem??

My overall aim is to take a spreadsheet, and with the data inside it copied and save into lots of different spreadsheets each with their own workbook. These individual workbooks, then need to be email to lots of different people.

Going deeper, the data in the first spreadsheet, where I am taking data from I need to check to ensure that I do not create duplicate spreadsheets. For example, if I have two rows called Frank, I want to create one workbook, not two. Further, as there could be rows with the same name, I want to copy all these rows into the one spreadsheet. Thus, if I have two rows called Frank, I want copy both of them into their workbook with the same name. Then I want create subtotals on the data in these individual works, and then email the workbooks to various people.

Does anyone have a code that can do this??? I really need it urgently!!! :(
 
Joined
Sep 4, 2003
Messages
4,912
The code isn't that hard to write and I'll be glad to help. If you can ZIP and post your sample workbook it would be much easier to understand exactly what you are trying to accomplish.

BTW...Do you want the emailing to be done automatically? If so, can you please indicate which email client you are using.

Rollin
 
Joined
Jun 23, 2004
Messages
167
Hi Noggy,

And welcome to TSG by the way, try this for the emailing part of it:
Code:
[SIZE=2]Option Explicit

Sub EmailActiveSheet()

      Dim ThisDate$, Recipient(1 To 50), N%
      Dim SendersBook As Workbook
      Dim RecipientsBook As Workbook

      Application.DisplayAlerts = False
      Application.ScreenUpdating = False

      'Set a Codename for the senders book
      Set SendersBook = Workbooks.Item(ActiveWorkbook.Name)

      'Get the list of recipients - (in A1 to A50 for this example)
      With Worksheets(1)
            For N = 1 To 50
                  If .Range("A" & N) = Empty Then GoTo DoNext
                  Recipient(N) = .Range("A" & N)
            Next N
      End With

DoNext:
      'Now create a new workbook to send
      Workbooks.Add
      ThisDate = Format(Date, "dd mmm yy")
      ActiveWorkbook.SaveAs "File for " & ThisDate & ".xls"

      'Set the Codename for this new workbook as "RecipientsBook"
      Set RecipientsBook = ActiveWorkbook
      SendersBook.Activate

      'Copy the active sheet and paste it into the recipients book.
      SendersBook.ActiveSheet.Copy Before:=RecipientsBook.Worksheets(1)
      RecipientsBook.Activate

      'Delete blank sheets in the recipients book
      For N = 1 To 3
            Sheets("Sheet" & N).Delete
      Next N

      '<< OPTION ONE: Send the new workbook without a message >>
      'ActiveWorkbook.SendMail Recipient, "Files for " & ThisDate
      '<< END OF OPTION ONE >>

      '<< OPTION TWO: Send the new workbook with a message
      ActiveWorkbook.HasRoutingSlip = True
      With ActiveWorkbook.RoutingSlip
            .Recipients = Recipient()
            .Subject = "Files for " & ThisDate
            .Message = "Hi," & vbLf & _
                       "" & vbLf & _
                       "Attached files are for...crap on..." & vbLf & _
                       "...more crap here.... " & vbLf & _
                       "" & vbLf & _
                       "Regards," & vbLf & _
                       "Senders name" & vbLf & _
                       "" & vbLf & _
                       "" & vbLf & _
                       "" & vbLf & _
                       ""
            .Delivery = xlAllAtOnce
            .ReturnWhenDone = False
      End With
      ActiveWorkbook.Route
      '<< END OF OPTION TWO >>

      'Delete the senders copy of the recipients book
      '(this was only a temp book for the sender)
      ActiveWorkbook.ChangeFileAccess xlReadOnly
      Kill ActiveWorkbook.FullName
      ActiveWorkbook.Close False

      'Let user know what's happened
      MsgBox "File sent by email ", , "Emailed..."
      Worksheets(1).Activate
      Application.DisplayAlerts = True
      Application.ScreenUpdating = True
End Sub[/SIZE]
Option 1 (commented out) sends the book without any message - if you want this option, remove the comments and comment out (or delete) Option 2.

Option 2 (as is) sends a "set' message to the recipients - CHANGE THIS MESSAGE to your own, I'm sure you don't want to tell all the recipients you're just 'crapping on'.

All the recipients email addys need to be put on sheet1 in Column A.

Now, I've included enough for 50 email addys, but I think you'll find that you may not be able to include that many addys on a single email, find out how many you can include and keep the number below that....

As for the other part of what you want to do - as rollin said, we need examples of what you mean...

Regards,
John
 

Noggy1

Thread Starter
Joined
Jan 29, 2005
Messages
51
Rollin_Again said:
The code isn't that hard to write and I'll be glad to help. If you can ZIP and post your sample workbook it would be much easier to understand exactly what you are trying to accomplish.

BTW...Do you want the emailing to be done automatically? If so, can you please indicate which email client you are using.

Rollin
Hi Rollin,

I have attached a small sample workbook as an example of the type of workbook that I need to divide up. The emailling doesn't need to be done automatically, I have decided on a design to keep the division of the source workbook separate to that of emailling. However, one other question, do you know whether Excel can cope sending 200 separate workbooks by email on 200 individual email addresses? As one individual workbook relates to one email address.

Can you help??
 

Attachments

Joined
Sep 4, 2003
Messages
4,912
I don't really know about Excel's direct email capabilities. I have always called Outlooks object model and sent the email from there. What email client will you be using?


Rollin
 
Joined
Sep 4, 2003
Messages
4,912
OK, now that you have posted the example. Can you please give a better explanation of what you are trying to do. Please make sure to fully explain what you mean by the following:

there could be rows with the same name
Also, what are each of the workbooks going to be named? How will their names be determined? More details please and we'll try to help.

Rollin
 

Noggy1

Thread Starter
Joined
Jan 29, 2005
Messages
51
The aim of my project is to take a very large workbook, which contains thousands of rows (approx 12000), and divide it up into lots of smaller ones. This workbook contains data that is built over the year, and holds data about purchases made by a number of departments. A department could make only one purchase a month, or many, or they could make lots of purchases a day. This is what I mean when a row doesn't have a unique identifier!! For example, Dept A could make 5 purchases in a day, but only one tomorrow; whiltst Dept B could make only one purchase, but none tomorrow. Unfortunately, I didn't design this large workbook, and it is not possible for me to do anything with it.

The task I have set myself is give every department their own workbook of all the purchases they have made over the year. But I need to ensure that I can group all the purchases made by a single department together in their own workbook, and then after checking, email it to department heads, using Outlook 2000.

Could you help??
 

Noggy1

Thread Starter
Joined
Jan 29, 2005
Messages
51
Sorry, all the individual workbooks, for the departments, are to named with the names of the departments. So, Dept A, will need to be named DeptA.xls. I thought it would be possible to take the name for each department from the Department column and use that as the naming convention for each workbook.

Thanks.
 
Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 807,865 other people just like you!

Latest posts

Staff online

Top