Copy selected mulitple worksheets to mulitple new workbooks

Copy selected mulitple worksheets to mulitple new workbooks

Post by VmVyZ2VsIE » Sat, 10 Mar 2007 03:57:15


Perhaps something like the code below, assuming the data is in Columns A and
B. Note that the "Name" property of a workbook is a read-only property and
in order for that to become "NewWB_XX", the workbook has to be saved with
that filename. Also, I have put "On Error Resume Next" to simplify and avoid
error handling. I recommend you take out that line and add appropriate error
handling.

Sub test()
Dim lRow As Long
Dim wb As Workbook

On Error Resume Next

With ThisWorkbook.Sheets("Sheet1")
lRow = 1
While .Range("A" & lRow).Text <> ""
Set wb = Nothing
Set wb = Workbooks(.Range("B" & lRow).Text & ".xls")
If wb Is Nothing Then
Set wb = Workbooks.Add
wb.SaveAs .Range("B" & lRow).Text
End If
ThisWorkbook.Sheets(.Range("A" & lRow).Text).Copy
After:=wb.Sheets(wb.Sheets.Count)
lRow = lRow + 1
Wend
End With
End Sub
 
 
 

Copy selected mulitple worksheets to mulitple new workbooks

Post by SWFu » Sat, 10 Mar 2007 05:12:09

I have a master workbook with several worksheets, some of which I want to
copy to new workbooks based on a table within the original workbook

So for example, I have worksheets TSheet1, TSheet2 .... TSheet8 in a
workbook, and arelisted in a table together with the name of the NewWB that I
want them copied to ..for example :

TSheet1 NewWB_01
TSheet2 NewWB_01
TSheet3 NewWB_02
TSheet4 NewWB_03
TSheet5 NewWB_01
TSheet6 NewWB_03
TSheet7 NewWB_02
TSheet8 NewWB_01

So the result should be 3 new workbooks NewWB_01, NewWB_02, NewWB_03 which
will each contain copies of the worksheets per the above list.

The number and names of both worksheets and new workbooks will need to vary
( I have simplified them in the above example)

--
Regards & Thanks