Circular reference and Naming sheet

[Karen]

The code below creates new worksheets in which formulas etc are taken
from a template.

A couple of problems,

1. I have managed to copy column H from the newly created worksheet
into a "Summary" sheet(drops into the next empty column ie i et seq)
however I get a circular reference error when copying Column C into
the next empty column after AB. I guess this is because I don't know
how to return back to the newly created sheet to execute the next
copy.

2. I would also like to enter the worksheet name into the first cell
of each copied column e.g. i1 and AC1 et seq but can't figure out how
to do this.

Any help is appreciated.


Karen

Code as follows:


Sub Create_Sheets()
Application.ScreenUpdating = False
Call DeleteDuplicates
For Each cell In Range("a1").CurrentRegion.SpecialCells(xlCellTypeConstants)
Dim SName As String
SName = cell.Value
If SheetExists(SName) = False Then
On Error Resume Next
Sheets("Template").Copy Before:=Sheets("Template")
ActiveSheet.Name = SName
Application.CutCopyMode = False
Range("H1:H386").Select
Selection.Copy
Sheets("Summary").Select
Range("A1").End(xlToRight).Offset(0, 1).Select
ActiveSheet.Paste Link:=True
'Problem from here
Range("C1:C386").Select
Selection.Copy
Sheets("Summary").Select
Range("IV1").End(xlToLeft).Offset(0, 1).Select
ActiveSheet.Paste Link:=True
Application.CutCopyMode = True
On Error GoTo 0
End If
Next cell
Application.ScreenUpdating = True
End Sub

 

[Tom Ogilvy]

Sub Create_Sheets()
Application.ScreenUpdating = False
Call DeleteDuplicates
For Each cell In Range("a1").CurrentRegion.SpecialCells(xlCellTypeConstants)
Dim SName As String
SName = cell.Value
If SheetExists(SName) = False Then
On Error Resume Next
Sheets("Template").Copy Before:=Sheets("Template")
ActiveSheet.Name = SName
Application.CutCopyMode = False
Range("H1:H386").Select
Selection.Copy
Sheets("Summary").Select
Range("A1").End(xlToRight).Offset(0, 1).Select
ActiveSheet.Paste Link:=True
'Problem from here
Sheets(sName).Select
Range("C1:C386").Select
Selection.Copy
Sheets("Summary").Select
Range("IV1").End(xlToLeft).Offset(0, 1).Select
ActiveSheet.Paste Link:=True
Application.CutCopyMode = True
On Error GoTo 0
End If
Next cell
Application.ScreenUpdating = True
End Sub

 

[Trevor Shuttleworth]

Karen

this is untested as I haven't got all the code but try this:

Sub Create_Sheets()
Application.ScreenUpdating = False
Dim SName As String
Call DeleteDuplicates
For Each cell In Range("a1").CurrentRegion.SpecialCells(xlCellTypeConstants)
SName = cell.Value
If SheetExists(SName) = False Then
On Error Resume Next
Set NewSheet = Sheets("Template").Copy(Before:=Sheets("Template"))
' <<<<<
NewSheet.Name = SName ' <<<<<
Range("H1:H386").Copy
Sheets("Summary").Select
Range("A1").End(xlToRight).Offset(0, 1).Select
ActiveSheet.Paste Link:=True

'Problem from here
NewSheet.Select ' <<<<<
Range("C1:C386").Copy
Sheets("Summary").Select
Range("IV1").End(xlToLeft).Offset(0, 1).Select
ActiveSheet.Paste Link:=True
Application.CutCopyMode = True
On Error GoTo 0
End If
Next 'cell
Application.ScreenUpdating = True
End Sub

I've removed some select/selection pairs and moved a couple of lines

Regards

Trevor

 

[Karen]

Thank you Tom/Trevor
Trevor, I had to tinker with the line " NewSheet.Name = SName '
<<<<<" to read " ActiveSheet.Name = SName ' <<<<<" to get it to
work.
FYI I utilised a function to solve my problem with the sheet names.
The completed code is below. Looks awful but it will have to do for
now.

Many Many thanks to both of you - have a nice day.

Karen

Function SHEETNAME() As String
Application.Volatile
SHEETNAME = Application.Caller.Worksheet.Name
End Function

Sub Create_Sheets()
Application.ScreenUpdating = False
Call DeleteDuplicates
For Each cell In Range("a1").CurrentRegion.SpecialCells(xlCellTypeConstants)
Dim SName As String
SName = cell.Value
If SheetExists(SName) = False Then
On Error Resume Next
Sheets("Template").Copy Before:=Sheets("Template")
ActiveSheet.Name = SName
Application.CutCopyMode = False
Range("H1:H386").Select
Selection.Copy
Sheets("Summary").Select
Range("A1").End(xlToRight).Offset(0, 1).Select
ActiveSheet.Paste Link:=True
Sheets(SName).Select
Range("C1:C386").Select
Selection.Copy
Sheets("Summary").Select
Range("IV1").End(xlToLeft).Offset(0, 1).Select
ActiveSheet.Paste Link:=True
Sheets(SName).Select
Range("F1").Select
Selection.Copy
Sheets("Summary").Select
Range("IV1").End(xlToLeft).Offset(0, 0).Select
ActiveSheet.Paste Link:=True
Sheets(SName).Select
Range("F1").Select
Selection.Copy
Sheets("Summary").Select
Range("A1").End(xlToRight).Offset(0, 0).Select
ActiveSheet.Paste Link:=True
Application.CutCopyMode = True
On Error GoTo 0
End If
Next cell
Application.ScreenUpdating = True
End Sub


"Trevor Shuttleworth" <[email protected]> wrote in message