Macro to copy sheets and create individual files

[rammergu]

Hi,

I maintain a workbook with 11 worksheets in it (named Sheet1, sheet2, etc).Each sheet contains information that i have to email to individuals. Ex: sheet 1 to user A, sheet 2 to user B, etc.

Currently, i copy the sheet and paste it to a new workbook, save it, and then email to all the 11 users.

Can you help me with the macro, which automates this process. It should basically copy the sheet, create a new book, and the file name should be the same as the sheet name.

Thanks in advance.

 

[agihcam]

Hi -
Welcome to the board.
try;

Sub TEST()
Dim NB, MB As Workbook
Set MB = ThisWorkbook
Dim I As Long
For I = 1 To Sheets.Count
    Set NB = Workbooks.Add
        ThisWorkbook.Sheets(I).Cells.Copy NB.Sheets(1).Range("A1")
        NB.SaveAs "C:\" & NB.Sheets(I).Name & ".XLS"
        NB.Close
Next
End Sub

 

[acw]

Hi

And here's one link to code that will allow you to send the item from excel.


http://www.mrexcel.com/board2/viewtopic.php?t=229361&highlight=outlook+application


Tony

 

[rammergu]

Thanks for the code. The code is working, however it not how exactly how i wanted it. I think i didnt explain very well,

there are 11 sheets, i go to each sheet tab, right click on it, click on 'move or copy', drop down and select '(new book)', check on 'copy'

A new work book is created with only one worksheet, retaining the name of the sheet and all the formatting.

Once this is done, i do a save as, and then close.

 

[agihcam]

how about this one?

Sub TEST()
Dim NB, MB As Workbook
Set MB = ThisWorkbook
Dim I, II As Long
For I = 1 To MB.Sheets.Count
    Set NB = Workbooks.Add
        MB.Sheets(I).Cells.Copy NB.Sheets(1).Range("A1")
        NB.Sheets(1).Name = MB.Sheets(I).Name
        For II = 2 To NB.Sheets.Count
            Application.DisplayAlerts = False
            NB.Sheets(2).Delete
            Application.DisplayAlerts = True
        Next
        NB.SaveAs "C:\" & MB.Sheets(I).Name & ".XLS"
        NB.Close
Next
End Sub

 

[Norie]

Try this.

For Each ws In Worksheets
      ws.Copy
      Set wb = ActiveWorkbook
      wb.SaveAs ThisWorkbook.Path & "/" & ws.Name
      ' put code to email here
      wb.Close
Next ws