Hi gm2612
This Code in the attached appears to do as you require. Please notice the Named Range "Customers" and the Hidden Sheet "Template". Change the Password as required.
In the Workbook Code Module
Option Explicit
Private Sub Workbook_Open()
Dim wSht As Worksheet
Dim PW As String
PW = "password" '<-------Change this as required
'set protection using UserInterface to allow macros to work
For Each wSht In ActiveWorkbook.Sheets
wSht.Protect _
Password:=PW, _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
UserInterfaceOnly:=True
wSht.EnableSelection = xlUnlockedCells
Next wSht
End Sub
In Sheet1 Code Module
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Dim NR As Long
Dim ws As Worksheet
Set ws = ActiveSheet
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Address = "$B$5" Then
With Range("Customers")
Set c = .Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
Sheets(Target.Value).Activate
Exit Sub
Else
With Sheets("Template")
.Visible = True
.Copy ThisWorkbook.Sheets(Sheets.Count)
.Visible = False
End With
With ActiveSheet
.Unprotect
.Name = Target.Value
.Range("D1").Value = Target.Value
.Protect
End With
End If
With ws
NR = .Cells(.Rows.Count, "G").End(xlUp).Row + 1
Application.EnableEvents = False
.Cells(NR, "G").Value = Target.Value
Application.EnableEvents = True
End With
End With
End If
End Sub
LinkBack URL
About LinkBacks
Need help for creating new sheet with predetermined tabular column in it
Register To Reply
Bookmarks