Adapt an automated advanced filter code to lock a particular column?

[Edie0512]

Yesterday I posted a question about automating an advanced filter and got a really helpful response from jaslake, thread here: http://www.excelforum.com/excel-prog...lp-needed.html

What I would now like to do, however, is one of the following:

1. Either lock and/or hide column L on the individual "Area" sheets that result from running the filter, so that an item can only be marked as complete on the "Master Timetable" sheet.

OR

2. Create some kind of dynamic link, so that if a user marks an item as complete (after running the update) on one of the "Area" sheets, it also updates the item on the Master Timetable, and does not lose the info the next time the update is run.

I'm not sure which of the two options is the easiest, to be honest.

The code that jaslake produced for me is as follows:

Option Explicit
Sub Do_Stuff()
    Dim LR As Long
    Dim Rng As Range
    Dim Cell As Range
    Application.ScreenUpdating = False
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Temp").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
    Sheets("Master timetable").Cells.Copy
    ActiveSheet.Range("A1").PasteSpecial
    Call UnMergeCells
    With Sheets("Data sheet")
        LR = .Range("A" & .Rows.Count).End(xlUp).Row
        ActiveWorkbook.Names.Add Name:="Areas", RefersTo:= _
                .Range("$A$31:$A" & LR)
    End With
    Set Rng = Range("Areas")
    For Each Cell In Rng
        With Sheets("Temp")
            LR = .Range("A" & .Rows.Count).End(xlUp).Row
            .AutoFilterMode = False
            .Range("F2:F" & LR).AutoFilter Field:=1, Criteria1:="=All", _
                    Operator:=xlOr, Criteria2:=Cell.Value
            If WorksheetExists(Cell.Value, ActiveWorkbook) Then
                Sheets(Cell.Value).Cells.Clear
                .UsedRange.SpecialCells(xlCellTypeVisible).Copy
                Sheets(Cell.Value).Range("A1").PasteSpecial
                Sheets(Cell.Value).Cells.WrapText = False
                Sheets(Cell.Value).Cells.Columns.AutoFit
            Else
                Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Cell.Value
                .UsedRange.SpecialCells(xlCellTypeVisible).Copy
                Sheets(Cell.Value).Range("A1").PasteSpecial
                Sheets(Cell.Value).Cells.WrapText = False
                Sheets(Cell.Value).Cells.Columns.AutoFit
            End If
            .AutoFilterMode = False
        End With
    Next Cell
    Application.DisplayAlerts = False
    Sheets("Temp").Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Sub UnMergeCells()
' From http://www.excelforum.com/excel-prog...th-values.html
    Dim oneCell As Range, onesFriends As Range
    With ThisWorkbook.Sheets("Temp")
        For Each oneCell In .UsedRange
            If oneCell.MergeCells Then
                Set onesFriends = oneCell.MergeArea
                oneCell.UnMerge
                onesFriends.Value = oneCell.Value
            End If
        Next oneCell
    End With
End Sub
Function WorksheetExists(SheetName As String, _
        Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
    Dim WB As Workbook
    Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
    On Error Resume Next
    WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) > 0)
End Function

And my workbook is attached below. Thank you in advance for any help, it would be much appreciated!