Hi,

I've got a control file which produces team workbooks - one sheet per member
of staff. It then adds in a manager template.

All this works.

The final step is to call a procedure, "PrepTheTemplate" which customises
the manager template to make it reflect the contents of the team workbook
(which it resides in). All the code is in the Batch Control workbook.

I think all the code in the "PrepTheTemplate" procedure works, but there's
one problem. No matter what I do, it inststs on executing the code on the
Batch Control workbook rather than the team one.

This has flummoxed everybody who I've been able to get to look at it, but
none of us are much good with VBA.

I'm a little desperate for a solution now as it's holding everything up.

The code is as follows: (the section that should change the context to the
team workbook is denoted by a )

Any help is very gratefully received.

Tom.



Sub PrepTheTemplate(CurrentSupervisor As String, CurrentLocation As String)

'select the correct workbook and sheet
Workbooks(CurrentLocation + " - " + CurrentSupervisor + ".xls").Activate
Sheets("Manager").Select

' Workbooks(CurrentLocation + " - " + CurrentSupervisor +
".xls").Sheets(Manager).Select

'dump the sheet names in to cells

sheetlistnumber = 1
Dim wks As Worksheet
For Each wks In Workbooks(CurrentLocation + " - " + CurrentSupervisor +
".xls").Worksheets
With Workbooks(CurrentLocation + " - " + CurrentSupervisor + ".xls")
.Sheets("Manager").Select
.Cells(sheetlistnumber + 28, 51).Value = wks.Name
.Cells(sheetlistnumber + 6, 1).Value = wks.Name
End With
sheetlistnumber = sheetlistnumber + 1
Next wks

Cells(18, 51).Value = sheetlistnumber - 1


' Fix range of pipeline chart

Worksheets("Manager").ChartObjects("Chart 1").Chart.SetSourceData _
Source:=Worksheets("Manager").Range("dPipelineChar t"), PlotBy:=ByRows

'find and replace with range of worksheets

Cells.Replace What:="a1a1a1a1:z9z9z9z9",
Replacement:=Range("BD16").Value, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False


'Clear name of manager sheet from pres area
'Range("A7").Select
'Selection.ClearContents

'nastybit

Dim WorB As Workbook
Dim SHee As Worksheet
Dim Rng As Range
Dim delRng As Range
Dim rCell As Range
Dim CalcMode As Long

Set WorB = ThisWorkbook
Set SHee = WorB.Sheets("Manager") '<<==== CHANGE
Set Rng = SHee.Range("A8:A31") '<<==== CHANGE

On Error Resume Next
Set Rng = Rng.SpecialCells(xlBlanks)
On Error GoTo XIT

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

If Not Rng Is Nothing Then
For Each rCell In Rng.Cells
If delRng Is Nothing Then
Set delRng = rCell.Resize(1, 18)
Else
Set delRng = Union(rCell.Resize(1, 18), delRng)
End If
Next rCell

If Not delRng Is Nothing Then
delRng.Delete shift:=xlUp
End If
End If
XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub