Hi, any help with the following would be really appreciated,

I have some VB Code, which works well, that for each change in a value in
column A creates a new sheet. However what I now need to do is to either;

a) create a new workbook for each of the newly created workshets, or
b) instead of creating a new sheet to directly create a workbook,

the ultimate end goal is to automatically email these workbooks or sheets.

my code for creating a new worksheet is

Sub create_new_sheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim lrow As Long

Set ws1 = Sheets("Sheet1")
Set rng = ws1.Range("A1:z10000").CurrentRegion

With Application
CalcMode = .Calculation
.Calculation = xlCalculationAutomatic
.ScreenUpdating = False
End With

With ws1
rng.Columns(1).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & lrow)
.Range("IU2").Value = cell.Value
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False

Cells.Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select

WSNew.Columns.AutoFit
WSNew.Range("A1:A6").EntireRow.Insert
WSNew.Range("A7:C8").Copy WSNew.Range("D3")
WSNew.Columns("A:C").Delete
WSNew.Columns("A").AutoFit

End Sub

Many thanks

--
Message posted via http://www.officekb.com

Try this example
http://www.rondebruin.nl/copy5_3.htm

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Ozzie via OfficeKB.com" <u18021@uwe wrote in message news:a250009bc86a2@uwe...
Hi, any help with the following would be really appreciated,

I have some VB Code, which works well, that for each change in a value in
column A creates a new sheet. However what I now need to do is to either;

a) create a new workbook for each of the newly created workshets, or
b) instead of creating a new sheet to directly create a workbook,

the ultimate end goal is to automatically email these workbooks or sheets.

my code for creating a new worksheet is

Sub create_new_sheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim lrow As Long

Set ws1 = Sheets("Sheet1")
Set rng = ws1.Range("A1:z10000").CurrentRegion

With Application
CalcMode = .Calculation
.Calculation = xlCalculationAutomatic
.ScreenUpdating = False
End With

With ws1
rng.Columns(1).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & lrow)
.Range("IU2").Value = cell.Value
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False

Cells.Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select

WSNew.Columns.AutoFit
WSNew.Range("A1:A6").EntireRow.Insert
WSNew.Range("A7:C8").Copy WSNew.Range("D3")
WSNew.Columns("A:C").Delete
WSNew.Columns("A").AutoFit

End Sub

Many thanks

--
Message posted via http://www.officekb.com

Oops I missed that
the ultimate end goal is to automatically email these workbooks or sheets.


If you want to mail it directly see
http://www.rondebruin.nl/mail/folder2/row2.htm

Or if you use Outlook
http://www.rondebruin.nl/mail/folder2/row2.htm

Or body
http://www.rondebruin.nl/mail/folder3/row2.htm




--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Ron de Bruin" wrote in message ...
Try this example
http://www.rondebruin.nl/copy5_3.htm

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Ozzie via OfficeKB.com" <u18021@uwe wrote in message news:a250009bc86a2@uwe...
Hi, any help with the following would be really appreciated,

I have some VB Code, which works well, that for each change in a value in
column A creates a new sheet. However what I now need to do is to either;

a) create a new workbook for each of the newly created workshets, or
b) instead of creating a new sheet to directly create a workbook,

the ultimate end goal is to automatically email these workbooks or sheets.

my code for creating a new worksheet is

Sub create_new_sheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim lrow As Long

Set ws1 = Sheets("Sheet1")
Set rng = ws1.Range("A1:z10000").CurrentRegion

With Application
CalcMode = .Calculation
.Calculation = xlCalculationAutomatic
.ScreenUpdating = False
End With

With ws1
rng.Columns(1).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & lrow)
.Range("IU2").Value = cell.Value
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False

Cells.Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select

WSNew.Columns.AutoFit
WSNew.Range("A1:A6").EntireRow.Insert
WSNew.Range("A7:C8").Copy WSNew.Range("D3")
WSNew.Columns("A:C").Delete
WSNew.Columns("A").AutoFit

End Sub

Many thanks

--
Message posted via http://www.officekb.com

Ron de Bruin wrote:
Try this example
http://www.rondebruin.nl/copy5_3.htm

Hi, any help with the following would be really appreciated,

[quoted text clipped - 68 lines]

Many thanks

Many thanks for all responses,

Ron,

Many thanks for your speedy response, the example spreadsheet with the code
that saves the workbooks into a folder and then creates a hyperlink is really
'spot on' and is something I hadn't considered. This is really efficient and
gets me around any company email limits!,

Thanks alot

--
Message posted via http://www.officekb.com

Hi Ozzie

You are welcome
See also the links to the mail examples if you want to do it in one step

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Ozzie via OfficeKB.com" <u18021@uwe wrote in message news:a250729f6051d@uwe...
Ron de Bruin wrote:
Try this example
http://www.rondebruin.nl/copy5_3.htm

Hi, any help with the following would be really appreciated,

[quoted text clipped - 68 lines]

Many thanks

Many thanks for all responses,

Ron,

Many thanks for your speedy response, the example spreadsheet with the code
that saves the workbooks into a folder and then creates a hyperlink is really
'spot on' and is something I hadn't considered. This is really efficient and
gets me around any company email limits!,

Thanks alot

--
Message posted via http://www.officekb.com

Since you have already created the sheets you can run this macro to save
each sheet as its own workbook.

Sub Make_New_Books()
Dim w As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each w In ActiveWorkbook.Worksheets
w.Copy
With ActiveWorkbook
.SaveAs FileName:=ThisWorkbook.Path _
& "\" & w.Name & ".xlsx"
.Close
End With
Next w
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Or see Ron de Bruin's site for code to create new workbooks directly from
unique values.

http://www.rondebruin.nl/copy5.htm


Gord Dibben MS Excel MVP

On Mon, 18 Jan 2010 21:33:14 GMT, "Ozzie via OfficeKB.com" <u18021@uwe
wrote:

Hi, any help with the following would be really appreciated,

I have some VB Code, which works well, that for each change in a value in
column A creates a new sheet. However what I now need to do is to either;

a) create a new workbook for each of the newly created workshets, or
b) instead of creating a new sheet to directly create a workbook,

the ultimate end goal is to automatically email these workbooks or sheets.

my code for creating a new worksheet is

Sub create_new_sheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim lrow As Long

Set ws1 = Sheets("Sheet1")
Set rng = ws1.Range("A1:z10000").CurrentRegion

With Application
CalcMode = .Calculation
.Calculation = xlCalculationAutomatic
.ScreenUpdating = False
End With

With ws1
rng.Columns(1).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & lrow)
.Range("IU2").Value = cell.Value
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False

Cells.Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select

WSNew.Columns.AutoFit
WSNew.Range("A1:A6").EntireRow.Insert
WSNew.Range("A7:C8").Copy WSNew.Range("D3")
WSNew.Columns("A:C").Delete
WSNew.Columns("A").AutoFit

End Sub

Many thanks

Gord look out with your code example
This will not work correct if the default save format in 2007 is not xlsx

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Gord Dibben" <gorddibbATshawDOTca wrote in message ...
Since you have already created the sheets you can run this macro to save
each sheet as its own workbook.

Sub Make_New_Books()
Dim w As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each w In ActiveWorkbook.Worksheets
w.Copy
With ActiveWorkbook
.SaveAs FileName:=ThisWorkbook.Path _
& "\" & w.Name & ".xlsx"
.Close
End With
Next w
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Or see Ron de Bruin's site for code to create new workbooks directly from
unique values.

http://www.rondebruin.nl/copy5.htm


Gord Dibben MS Excel MVP

On Mon, 18 Jan 2010 21:33:14 GMT, "Ozzie via OfficeKB.com" <u18021@uwe
wrote:

Hi, any help with the following would be really appreciated,

I have some VB Code, which works well, that for each change in a value in
column A creates a new sheet. However what I now need to do is to either;

a) create a new workbook for each of the newly created workshets, or
b) instead of creating a new sheet to directly create a workbook,

the ultimate end goal is to automatically email these workbooks or sheets.

my code for creating a new worksheet is

Sub create_new_sheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim lrow As Long

Set ws1 = Sheets("Sheet1")
Set rng = ws1.Range("A1:z10000").CurrentRegion

With Application
CalcMode = .Calculation
.Calculation = xlCalculationAutomatic
.ScreenUpdating = False
End With

With ws1
rng.Columns(1).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & lrow)
.Range("IU2").Value = cell.Value
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False

Cells.Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select

WSNew.Columns.AutoFit
WSNew.Range("A1:A6").EntireRow.Insert
WSNew.Range("A7:C8").Copy WSNew.Range("D3")
WSNew.Columns("A:C").Delete
WSNew.Columns("A").AutoFit

End Sub

Many thanks

Ron de Bruin wrote:
Gord look out with your code example
This will not work correct if the default save format in 2007 is not xlsx

Since you have already created the sheets you can run this macro to save
each sheet as its own workbook.
[quoted text clipped - 94 lines]

Many thanks

Ron,

Its OK as I am using XL2003. One quick question though, another step, and
final step, would be to add two sheets to the new workbook instead of one.

The first sheet would have the new copied data (already done by you earlier),
the second sheet would need to have a pivot table created that linked to
sheet 1.

I don't suppose you could help with this also could you?,

many thanks

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/201001/1

When the code create the workbook you can add another sheet and create the pivot also with code
before you save the file.

Bedtime for me now but I will help tomorrow with the code


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Ozzie via OfficeKB.com" <u18021@uwe wrote in message news:a250acd678a2c@uwe...
Ron de Bruin wrote:
Gord look out with your code example
This will not work correct if the default save format in 2007 is not xlsx

Since you have already created the sheets you can run this macro to save
each sheet as its own workbook.
[quoted text clipped - 94 lines]

Many thanks

Ron,

Its OK as I am using XL2003. One quick question though, another step, and
final step, would be to add two sheets to the new workbook instead of one.

The first sheet would have the new copied data (already done by you earlier),
the second sheet would need to have a pivot table created that linked to
sheet 1.

I don't suppose you could help with this also could you?,

many thanks

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/201001/1

Ron de Bruin wrote:
When the code create the workbook you can add another sheet and create the pivot also with code
before you save the file.

Bedtime for me now but I will help tomorrow with the code

Gord look out with your code example
This will not work correct if the default save format in 2007 is not xlsx
[quoted text clipped - 17 lines]

many thanks

hi Ron,

I don't suppose you have had chance to have a look at this additional have
you?

Many thanks

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/201001/1

Thanks Ron

Didn't you tell me this a few months ago<g


Gord

On Mon, 18 Jan 2010 23:28:37 +0100, "Ron de Bruin"
wrote:

Gord look out with your code example
This will not work correct if the default save format in 2007 is not xlsx