View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Mat P:son[_2_] Mat P:son[_2_] is offline
external usenet poster
 
Posts: 97
Default Create seprate files from multiple sheets in excel

And by all means, check out for example Ron de Bruin's web site with Excel
tips and tricks (the following link is in fact directly relevant to worksheet
copying):

http://www.exceltip.com/st/Copy_a_sh...Excel/560.html

"Mat P:son" wrote:

Okay, you can put the following code in for example your ThisWorkbook code
module in BookA.

I just hacked it together, and I'm not yet deleting the original sheets
(Sheet1-3) in the newly generated workbooks, simply because I haven't figured
out a way to turn off Excel's warning yet (but it cannot be impossible). The
same goes for overwriting already existing workbook files (generates
warnings, must obviously be possible to turn off).

The code isn't very robust since it doesn't do any proper error checking,
but it's still okay for demo purposes, I reckon :o)

Of course, you should change the constants as you see fit.

HTH,
/MP

========================================

Option Explicit

Private Const BookIter As String = "BookA.xls"
Private Const BookCopy As String = "BookB.xls"

Private Const FilePath As String = "C:\tmp\"
Private Const FilePrefix As String = "split_"
Private Const FileSuffix As String = ".xls"

Private Sub SplitBooks()
Dim wbIter As Workbook
Dim wbCopy As Workbook

Set wbIter = Workbooks(BookIter)
Set wbCopy = Workbooks(BookCopy)

Dim bUpdateState As Boolean
bUpdateState = Application.ScreenUpdating
Application.ScreenUpdating = False

Dim wbNew As Workbook
Dim wsIter As Worksheet
For Each wsIter In wbIter.Worksheets
Set wbNew = Workbooks.Add
SetNewWbSheets wbNew, wsIter, wbCopy
wbNew.SaveAs GetFileName(wbNew, wsIter)
Next wsIter

Application.ScreenUpdating = bUpdateState
End Sub

Private Sub SetNewWbSheets( _
wbNew As Workbook, _
wsIter As Worksheet, _
wbCopy As Workbook)

wsIter.Copy , wbNew.Worksheets(wbNew.Worksheets.Count)

Dim ws As Worksheet
For Each ws In wbCopy.Worksheets
ws.Copy , wbNew.Worksheets(wbNew.Worksheets.Count)
Next ws

Dim i As Integer
For i = 1 To 3
' TODO:
' Still generates annoying warnings;
' but must be possible to disable?!
'wbNew.Worksheets(1).Delete
Next i
End Sub

Private Function GetFileName(wb As Workbook, ws As Worksheet) As String
GetFileName = FilePath & FilePrefix & ws.Name & FileSuffix
End Function

==============================================

"Shuvro Basu" wrote:

Hi All,

Here is what I need to do:

I have 2 excel workbooks. For simplicity lets assume them to be BookA
and BookB. BookA has 20 odd worksheets (say s1, s2..........s20) and
BookB has 3 sheets (say bs1,bs2 and bs3). What I need to do create a
file that has s1 from BookA and bs1 to bs3 of BookB in that order.
Hence I would have 20 files (for the 20 sheets of BookA) each with the
filename as "SomePrefix_S1.xls" ........ "SomePrefix_S20.xls".

I tried to do this but unfortunately lost my control on the code and
just too confused to know where to start again. Any help in this regard
or pointers will be highly appreciated.

Regds