<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; background-color: #ffffff; min-height: 13.0px}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #000000; background-color: #ffffff}p.p3 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #011993; background-color: #ffffff}span.s1 {color: #011993}span.s2 {color: #000000}</style>
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim Rng4 As Range
Dim isect1 As Range
Dim isect2 As Range
Dim isect3 As Range
Dim isect4 As Range
If Target.Count > 1 Then Exit Sub
If Target.Address(False, False) = "B2" Then Call TitleCheck
If Target.Address(False, False) = "E2" Then Call CompanyCheck
If Target.Address(False, False) = "G2" Then Call DateCheck
Set Rng1 = Range("A11:G22")
Set Rng2 = Range("A26:G34")
Set Rng3 = Range("A38:G46")
Set Rng4 = Range("A50:G58")
Set isect1 = Intersect(Target, Rng1)
Set isect2 = Intersect(Target, Rng2)
Set isect3 = Intersect(Target, Rng3)
Set isect4 = Intersect(Target, Rng4)
If isect1 Is Nothing And isect2 Is Nothing And isect3 Is Nothing And isect4 Is Nothing Then Exit Sub
If Application.CountIf(ActiveSheet.UsedRange, Target.Value) = 1 Then
Set MyActiveCell = ActiveCell
Sheets("Timesheet").Cells.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Name = Target.Value
End If
Sheets("Labour Week").Activate
MyActiveCell.Select
Application.ScreenUpdating = True
[COLOR=#011993][FONT=Menlo]End[/FONT][/COLOR][FONT=Menlo] [/FONT][COLOR=#011993][FONT=Menlo]Sub[/FONT][/COLOR]/CODE]