Code is in sheet "Summary" module.
This works fine as far as adding a number of sheet and naming them from the list C9:Cn on sheet named "Summary". There are four names and I get four regular sheets with those names.

What I want to do is COPY the sheet next to "Summary" which is named "Main Swb" and name the copies from the list in the "Summary" sheet C9:Cn.

Sheet "Main Swb" has some 'bells and whistles' color formatting, a few formulas and some 'merged cells" (big frown here). I need to keep all the goodies intact when copied and renamed.

So, I wind up with four copies of "Main Swb" with four different names.

I've tried to Set nSht = Sheets("Main Swb").Copy After:=Sheets(Sheets.Count)
but it errors out.

Thanks,
Howard

Option Explicit

Sub CreateSheets()
Dim nSht As Worksheet
Dim r As Integer
r = 9
Do While Sheets("Summary").Cells(r, 3).Value < ""
Set nSht = Sheets.Add
'Names for the new sheet are in C9:Cn of "Summary"
nSht.Name = Sheets("Summary").Cells(r, 3).Value
r = r + 1
Loop
End Sub

Hi Howard,

Am Sun, 7 Apr 2013 07:09:42 -0700 (PDT) schrieb Howard:

Code is in sheet "Summary" module.
This works fine as far as adding a number of sheet and naming them from the list C9:Cn on sheet named "Summary". There are four names and I get four regular sheets with those names.

What I want to do is COPY the sheet next to "Summary" which is named "Main Swb" and name the copies from the list in the "Summary" sheet C9:Cn.

try:

Sub CreateSheets()
Dim LRow As Long
Dim rngC As Range

With Sheets("Summary")
LRow = .Cells(Rows.Count, 3).End(xlUp).Row
For Each rngC In .Range("C9:C" & LRow)
ActiveWorkbook.Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = rngC
Next
End With
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Howard,

Am Sun, 7 Apr 2013 16:19:59 +0200 schrieb Claus Busch:

sorry, but I didn't read carefully.
Try:

Sub CreateSheets()
Dim LRow As Long
Dim rngC As Range

With Sheets("Summary")
LRow = .Cells(Rows.Count, 3).End(xlUp).Row
For Each rngC In .Range("C9:C" & LRow)
Sheets("Main Swb").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = rngC
Next
End With
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Sunday, April 7, 2013 7:38:00 AM UTC-7, Claus Busch wrote:
Hi Howard,



Am Sun, 7 Apr 2013 16:19:59 +0200 schrieb Claus Busch:



sorry, but I didn't read carefully.

Try:



Sub CreateSheets()

Dim LRow As Long

Dim rngC As Range



With Sheets("Summary")

LRow = .Cells(Rows.Count, 3).End(xlUp).Row

For Each rngC In .Range("C9:C" & LRow)

Sheets("Main Swb").Copy After:=Sheets(Sheets.Count)

ActiveSheet.Name = rngC

Next

End With

End Sub





Regards

Claus Busch

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

Thanks, Claus.

I tried you revised code and it copied several, say about 17, sheets named ("Main Swb12") and various other numbers and ignored the names listed in
For Each rngC In .Range("C9:C" & LRow).

I revised the code to this:

Sub CreateSheetsClaus()
'Dim LRow As Long
Dim rngC As Range

With Sheets("Summary")
'LRow = .Cells(Rows.Count, 3).End(xlUp).Row
For Each rngC In .Range("C9:C24")
Sheets("Main Swb").Copy After:=Sheets(Sheets.Count)
Next
End With
End Sub

And it produced the same thing.
Where Range("C9:C24") on "Summary" sheet has only four names and all other cells are blank. Puzzling.

Here is a link to the workbook I am working with if you get the time to investigate. Not sure what is messing things up.

https://www.dropbox.com/s/3letip961h...20Version.xlsm

Thanks.
Howard



https://www.dropbox.com/s/3letip961h...20Version.xlsm

Hi Howard,

Am Sun, 7 Apr 2013 08:47:17 -0700 (PDT) schrieb Howard:


I tried you revised code and it copied several, say about 17, sheets named ("Main Swb12") and various other numbers and ignored the names listed in
For Each rngC In .Range("C9:C" & LRow).

two things:
1. the code should be placed in a standard module
2. I missed one line of code. The important line:
ActiveSheet.Name = rngC

look here for your workbook "TENDER SHEET":
https://skydrive.live.com/#cid=9378A...121822A3%21191


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

two things:

1. the code should be placed in a standard module

2. I missed one line of code. The important line:

ActiveSheet.Name = rngC



look here for your workbook "TENDER SHEET":

https://skydrive.live.com/#cid=9378A...121822A3%21191





Regards

Claus Busch

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

Good as gold, Claus.

Thanks a bunch.

Regards,
Howard

I tried to have a look at your file but it was no longer there!

While certain that Claus provided an excellent solution, I offer a
version that doesn't loop each range on "Summary" for the names of the
copied sheets.

Sub CopyAndNameSheets()
Dim vNames, n&, lRow&
With Sheets("Summary")
lRow = .Cells(.Rows.Count, 3).End(xlUp).Row
vNames = .Range("C1:C" & lRow)
End With
For n = LBound(vNames) To UBound(vNames)
Sheets("Main Swb").Copy after:=Sheets("Main Swb")
ActiveSheet.Name = vNames(n, 1)
Next 'n
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Garry,

Am Sun, 07 Apr 2013 14:24:57 -0400 schrieb GS:

Sub CopyAndNameSheets()
Dim vNames, n&, lRow&
With Sheets("Summary")
lRow = .Cells(.Rows.Count, 3).End(xlUp).Row
vNames = .Range("C1:C" & lRow)
End With
For n = LBound(vNames) To UBound(vNames)
Sheets("Main Swb").Copy after:=Sheets("Main Swb")
ActiveSheet.Name = vNames(n, 1)
Next 'n
End Sub

you didn't know the structure of the table. So you have to change two
lines of your code:

lRow = 8 + WorksheetFunction.CountA([C9:C24])
vNames = .Range("C9:C" & lRow)


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Garry,

Am Sun, 07 Apr 2013 14:24:57 -0400 schrieb GS:

Sub CopyAndNameSheets()
Dim vNames, n&, lRow&
With Sheets("Summary")
lRow = .Cells(.Rows.Count, 3).End(xlUp).Row
vNames = .Range("C1:C" & lRow)
End With
For n = LBound(vNames) To UBound(vNames)
Sheets("Main Swb").Copy after:=Sheets("Main Swb")
ActiveSheet.Name = vNames(n, 1)
Next 'n
End Sub

you didn't know the structure of the table. So you have to change two
lines of your code:

lRow = 8 + WorksheetFunction.CountA([C9:C24])
vNames = .Range("C9:C" & lRow)


Regards
Claus Busch

Claus,
The code is just a general example of how to not read each cell
directly from sheet. Now that I've downloaded Howard's file I see that
it would need to be modified to work with the structure. In this case I
suggest naming the list under col heading "BREAKDOWN" as a dynamic
range, and use this to load vNames.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Revised as per my suggested approach (and handles the hidden sheet)...

Sub CopySheetAndNameCopies()
Dim vNames, n&
vNames = Sheets("Summary").Range("BreakdownList")

Application.ScreenUpdating = False
Sheets("Main Swb").Visible = True

For n = LBound(vNames) To UBound(vNames)
Sheets("Main Swb").Copy after:=Sheets("Summary")
ActiveSheet.Name = vNames(n, 1)
Next 'n

Sheets("Main Swb").Visible = False
Application.ScreenUpdating = True
End Sub

...where Range("BreakdownList") is a dynamic Defined Name range with
local scope.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

On Sunday, April 7, 2013 4:52:58 PM UTC-7, GS wrote:
Revised as per my suggested approach (and handles the hidden sheet)...



Sub CopySheetAndNameCopies()

Dim vNames, n&

vNames = Sheets("Summary").Range("BreakdownList")



Application.ScreenUpdating = False

Sheets("Main Swb").Visible = True



For n = LBound(vNames) To UBound(vNames)

Sheets("Main Swb").Copy after:=Sheets("Summary")

ActiveSheet.Name = vNames(n, 1)

Next 'n



Sheets("Main Swb").Visible = False

Application.ScreenUpdating = True

End Sub

..where Range("BreakdownList") is a dynamic Defined Name range with

local scope.

Garry

Thanks,Garry.

I have never worked with hidden sheets before, never had a cause to do so. Not as daunting as I thought it might be.

I'll test fly your code which I know already will work and archive it along with Claus's.

Thanks again.

Howard

On Sunday, April 7, 2013 11:24:57 AM UTC-7, GS wrote:
I tried to have a look at your file but it was no longer there!



While certain that Claus provided an excellent solution, I offer a

version that doesn't loop each range on "Summary" for the names of the

copied sheets.



Sub CopyAndNameSheets()

Dim vNames, n&, lRow&

With Sheets("Summary")

lRow = .Cells(.Rows.Count, 3).End(xlUp).Row

vNames = .Range("C1:C" & lRow)

End With

For n = LBound(vNames) To UBound(vNames)

Sheets("Main Swb").Copy after:=Sheets("Main Swb")

ActiveSheet.Name = vNames(n, 1)

Next 'n

End Sub



--

Garry



Free usenet access at http://www.eternal-september.org

Classic VB Users Regroup!

comp.lang.basic.visual.misc

microsoft.public.vb.general.discussion

Hi Garry,

Always glad to see/hear your 'Double Eagle' worth of advice. (Where "Double Eagle" replaces "two cents")<g

Here is a new link to a newer version that has the sheet to be copied, "Main Swb", hidden.

I made simple additions to Claus's code and it seems to work quite well.

https://www.dropbox.com/s/vwq5ao0a8x...ox%20V 1.xlsm

I would assume I could add the Unhide / Hide code lines to your version and get the same results.

Howard

Hi Garry,

Always glad to see/hear your 'Double Eagle' worth of advice. (Where
"Double Eagle" replaces "two cents")<g

Here is a new link to a newer version that has the sheet to be
copied, "Main Swb", hidden.

I made simple additions to Claus's code and it seems to work quite
well.

https://www.dropbox.com/s/vwq5ao0a8x...ox%20V 1.xlsm

I would assume I could add the Unhide / Hide code lines to your
version and get the same results.

Howard

Thanks for the link! I got a look at your file and see my code doesn't
fit it exactly. See my reply to Claus for my comments regarding how I'd
approach the task...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Claus and Gary,

Turns out once these new sheets are copied, there is a need for formulas on the Summary sheet to refer to certain cells of each new sheet and return values from each new sheet to Summary. I used four offset lines to get it done, while I have some vision of it all in one line...nothing comes to mind..

This works fine, but I would appreciate an assement from you pros.

Sub CreateSheetsClaus_UnHide_Copy_Hide()
Dim rngC As Range
Application.ScreenUpdating = False
Sheets("Main Swb").Visible = True
With Sheets("Summary")
For Each rngC In .Range("C9:C24")
If Len(rngC) 0 Then
Sheets("Main Swb").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = rngC
rngC.Offset(0, 1).Formula = "='" & rngC & "'!G7"
rngC.Offset(0, 2).Formula = "='" & rngC & "'!H7"
rngC.Offset(0, 3).Formula = "='" & rngC & "'!I7"
rngC.Offset(0, 4).Formula = "='" & rngC & "'!J7"
End If
Next
End With
Sheets("Main Swb").Visible = False
Application.ScreenUpdating = True
End Sub

Thanks.
Howard

Hi Howard,

Am Mon, 8 Apr 2013 06:43:10 -0700 (PDT) schrieb Howard:

rngC.Offset(0, 1).Formula = "='" & rngC & "'!G7"
rngC.Offset(0, 2).Formula = "='" & rngC & "'!H7"
rngC.Offset(0, 3).Formula = "='" & rngC & "'!I7"
rngC.Offset(0, 4).Formula = "='" & rngC & "'!J7"

you can shorten it:
rngC.Offset(0, 1).Resize(1, 4).Formula = _
"='" & rngC & "'!G7"


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Monday, April 8, 2013 7:34:36 AM UTC-7, Claus Busch wrote:
Hi Howard,



Am Mon, 8 Apr 2013 06:43:10 -0700 (PDT) schrieb Howard:



rngC.Offset(0, 1).Formula = "='" & rngC & "'!G7"

rngC.Offset(0, 2).Formula = "='" & rngC & "'!H7"

rngC.Offset(0, 3).Formula = "='" & rngC & "'!I7"

rngC.Offset(0, 4).Formula = "='" & rngC & "'!J7"



you can shorten it:

rngC.Offset(0, 1).Resize(1, 4).Formula = _

"='" & rngC & "'!G7"





Regards

Claus Busch

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

Thanks, Claus. As I said I envisioned a one liner but clearly beyond my Excel skills.

Funny though, I can read it and understand what its doing. That will be a good one to keep around and refer to.

Thanks again.

Howard

Hi Howard,

Am Mon, 8 Apr 2013 08:32:46 -0700 (PDT) schrieb Howard:

Funny though, I can read it and understand what its doing. That will be a good one to keep around and refer to.

at the moment you have 4 rows in Summary with values. When will you run
the macro? If all 24 rows are filled?
If you run the macro now and later you make new entries and you will run
the macro again, you must test which sheets already exists.
Then you better try:

Sub CopyMainSwb()
Dim arrNames, n As Integer
Dim SheetExists As Boolean

Application.ScreenUpdating = False
With Sheets("Summary")
arrNames = .Range("C9:C32").SpecialCells(xlCellTypeConstants)

For n = LBound(arrNames) To UBound(arrNames)
On Error Resume Next
SheetExists = Not Sheets(arrNames(n, 1)) Is Nothing
If SheetExists = False Then
Sheets("Main Swb").Copy befo=Sheets("NOTES")
ActiveSheet.Name = arrNames(n, 1)
.Range("C9:C32").SpecialCells(xlCellTypeConstants) _
.Cells(n).Offset(, 1).Resize(1, 4) = _
"='" & arrNames(n, 1) & "'!G7"
End If
Next
End With
Application.ScreenUpdating = True
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Claus,
Very good point!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

at the moment you have 4 rows in Summary with values. When will you run

the macro? If all 24 rows are filled?

If you run the macro now and later you make new entries and you will run

the macro again, you must test which sheets already exists.

Then you better try:



Sub CopyMainSwb()

Dim arrNames, n As Integer

Dim SheetExists As Boolean



Application.ScreenUpdating = False

With Sheets("Summary")

arrNames = .Range("C9:C32").SpecialCells(xlCellTypeConstants)



For n = LBound(arrNames) To UBound(arrNames)

On Error Resume Next

SheetExists = Not Sheets(arrNames(n, 1)) Is Nothing

If SheetExists = False Then

Sheets("Main Swb").Copy befo=Sheets("NOTES")

ActiveSheet.Name = arrNames(n, 1)

.Range("C9:C32").SpecialCells(xlCellTypeConstants) _

.Cells(n).Offset(, 1).Resize(1, 4) = _

"='" & arrNames(n, 1) & "'!G7"

End If

Next

End With

Application.ScreenUpdating = True

End Sub





Regards

Claus Busch


Excellent point!

Up to now I just had a little macro that would delete the newly made sheets so I could go on about doing test with the codes. That issue was bound to come up once the sheet was in general use instead of testing and developing.

Thanks for the look-ahead.

Howard

For the non read/write directly to ranges approach, make sure the top
of the code window has the following...

Option Explicit
Option Base 1

...and replace CopySheetAndNameCopies() with whichever of the following
you like...

Sub CopySheetAndNameCopies_v2()
Dim vNames, sFormulas, n&, k&
vNames = Sheets("Summary").Range("BreakdownList")

Application.ScreenUpdating = False
Sheets("Main Swb").Visible = True

For n = LBound(vNames) To UBound(vNames)
Sheets("Main Swb").Copy after:=Sheets("Summary")
ActiveSheet.Name = vNames(n, 1)
sFormulas = "='" & vNames(n, 1) & "'!G7"
Sheets("Summary").Range("BreakdownList").Cells(n). Offset(,
1).Resize(1, 4) = sFormulas
Next 'n

Sheets("Main Swb").Visible = False
Application.ScreenUpdating = True
End Sub


Sub CopySheetAndNameCopies_v3()
Dim vNames, vFormulaRefs, vaFormulas(1, 4), n&, k&
vNames = Sheets("Summary").Range("BreakdownList")
vFormulaRefs = Array("G7", "H7", "I7", "J7")

Application.ScreenUpdating = False
Sheets("Main Swb").Visible = True

For n = LBound(vNames) To UBound(vNames)
Sheets("Main Swb").Copy after:=Sheets("Summary")
ActiveSheet.Name = vNames(n, 1)
For k = 1 To 4
vaFormulas(1, k) = "='" & vNames(n, 1) & "'!" & vFormulaRefs(k)
Next 'k
Sheets("Summary").Range("BreakdownList").Cells(n). Offset(,
1).Resize(1, UBound(vaFormulas, 2)) = vaFormulas
Next 'n

Sheets("Main Swb").Visible = False
Application.ScreenUpdating = True
End Sub

...and take care to catch any line wraps. (All code is single lines)

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Revised to handle existing sheets...

Sub CopySheetAndNameCopies_v2()
Dim vNames, sFormulas, n&, k&
vNames = Sheets("Summary").Range("BreakdownList")

Application.ScreenUpdating = False
Sheets("Main Swb").Visible = True

For n = LBound(vNames) To UBound(vNames)
If Sheets(vNames(n, 1)) Is Nothing Then
Sheets("Main Swb").Copy after:=Sheets("Summary")
ActiveSheet.Name = vNames(n, 1): sFormulas = "='" & vNames(n, 1)
& "'!G7"
Sheets("Summary").Range("BreakdownList").Cells(n). Offset(,
1).Resize(1, 4) = sFormulas
End If 'Sheets(vNames(n, 1)) Is Nothing
Next 'n

Sheets("Main Swb").Visible = False
Application.ScreenUpdating = True
End Sub

Sub CopySheetAndNameCopies_v3()
Dim vNames, vFormulaRefs, vaFormulas(1, 4)
Dim n&, k&
vNames = Sheets("Summary").Range("BreakdownList")
vFormulaRefs = Array("G7", "H7", "I7", "J7")

Application.ScreenUpdating = False
Sheets("Main Swb").Visible = True

For n = LBound(vNames) To UBound(vNames)
If Sheets(vNames(n, 1)) Is Nothing Then
Sheets("Main Swb").Copy after:=Sheets("Summary")
ActiveSheet.Name = vNames(n, 1)
For k = 1 To 4
vaFormulas(1, k) = "='" & vNames(n, 1) & "'!" & vFormulaRefs(k)
Next 'k
Sheets("Summary").Range("BreakdownList").Cells(n). Offset(,
1).Resize(1, UBound(vaFormulas, 2)) = vaFormulas
End If 'Sheets(vNames(n, 1)) Is Nothing
Next 'n

Sheets("Main Swb").Visible = False
Application.ScreenUpdating = True
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Garry,

Am Mon, 08 Apr 2013 14:38:11 -0400 schrieb GS:

If Sheets(vNames(n, 1)) Is Nothing Then

you will get an error ^^^^^^

Sub CopyMainSwb()
Dim arrNames, n As Integer

Application.ScreenUpdating = False
With Sheets("Summary")
arrNames = .Range("C9:C32").SpecialCells(xlCellTypeConstants)

For n = LBound(arrNames) To UBound(arrNames)
On Error Resume Next
If Sheets(arrNames(n, 1)) Is Nothing Then
Sheets("Main Swb").Copy befo=Sheets("NOTES")
ActiveSheet.Name = arrNames(n, 1)
.Range("C9:C32").SpecialCells(xlCellTypeConstants) _
.Cells(n).Offset(, 1).Resize(1, 4) = _
"='" & arrNames(n, 1) & "'!G7"
End If
Next
End With
Application.ScreenUpdating = True
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Thanks, Claus! You're absolutely correct! (I got lazy<g, my bad)...

Sub CopySheetAndNameCopies_v2()
Dim vNames, sFormulas, n&, k&
vNames = Sheets("Summary").Range("BreakdownList")

Application.ScreenUpdating = False
Sheets("Main Swb").Visible = True

For n = LBound(vNames) To UBound(vNames)
If not bSheetExists(vNames(n, 1)) Then
Sheets("Main Swb").Copy after:=Sheets("Summary")
ActiveSheet.Name = vNames(n, 1)
sFormulas = "='" & vNames(n, 1) & "'!G7"
Sheets("Summary").Range("BreakdownList").Cells(n). Offset(,
1).Resize(1, 4) = sFormulas
End If 'Not bSheetExists
Next 'n

Sheets("Main Swb").Visible = False
Application.ScreenUpdating = True
End Sub

Sub CopySheetAndNameCopies_v3()
Dim vNames, vFormulaRefs, vaFormulas(1, 4)
Dim n&, k&
vNames = Sheets("Summary").Range("BreakdownList")
vFormulaRefs = Array("G7", "H7", "I7", "J7")

Application.ScreenUpdating = False
Sheets("Main Swb").Visible = True

For n = LBound(vNames) To UBound(vNames)
If not bSheetExists(vNames(n, 1)) Then
Sheets("Main Swb").Copy after:=Sheets("Summary")
ActiveSheet.Name = vNames(n, 1)
For k = 1 To 4
vaFormulas(1, k) = "='" & vNames(n, 1) & "'!" & vFormulaRefs(k)
Next 'k
Sheets("Summary").Range("BreakdownList").Cells(n). Offset(,
1).Resize(1, UBound(vaFormulas, 2)) = vaFormulas
End If 'Not bSheetExists
Next 'n

Sheets("Main Swb").Visible = False
Application.ScreenUpdating = True
End Sub

Function bSheetExists(WksName) As Boolean
On Error Resume Next
bSheetExists = CBool(Len(ActiveWorkbook.Sheets(WksName).Name))
End Function

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion