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(xlCellTypeC onstants)
Dim SName As String
SName = cell.Value
If SheetExists(SName) = False Then
On Error Resume Next
Sheets("Template").Copy Befo=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" wrote in message