Thanks. That'll certainly help.

The key stumbling block is a little higher up - it's this code:

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



No matter what I do, it still sumps the sheet names into the Batch Control
book, not the team one.

Cheers,

Tom.


"Vergel Adriano" wrote:

Tom,

You need to change this line:

Set WorB = ThisWorkbook

to something like

Set WorB = ActiveWorkbook 'get the currently active workbook

or

Set WorB = Workbooks("sample.xls") ' get the workbook named sample.xls


ThisWorkbook refers to the workbook that contains the code and since you
said all your code is in the batch workbook, I think that's where your
problem is..


--
Hope that helps.

Vergel Adriano


"mr tom" wrote:

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