This is the macro that's failing:


Sub save_report()
'1. select five new 'mandatory' (O/G/E/I/R) sheets from report master file
and dump into new WB
' -- uses selname and resname set above to select O and R sheets
'2. dump customer & drill sheets into new WB
'3. add glossary(ies)
'4. save & close new WB

Dim M_S As Object
Set M_S = MATRIX_STATIONS 'sheet used for misc referencing
Dim fn As String
Dim WSn(0, 4) As String
Dim sh As Worksheet
Dim blnReplace As Boolean 'this isn't used now as I process one sheet at a
time
Dim w As Integer
Dim stn As String
Dim WSo As Object
Dim src As String, bkmk As String, txt As String


Set WB = Workbooks("REPORT.xls")


'testing
' Set M_M = MATRIX_MISC 'similar to M_S set above
' selname = "Overview MAN 2009-06"
' BR = "BMAN"
' resname = "MAN Alerts 2009-06"


'--------------------
' MANDATORY SHEETS
'--------------------

'select mandatory (O/G/E/I/A) sheets from scorecard master file and dump
into new WB

WSn(0, 0) = selname
WSn(0, 1) = "General"
WSn(0, 2) = "Export"
WSn(0, 3) = "Import"
WSn(0, 4) = resname

'only works on sheets that exist

If fn_SheetExists(WSn(0, 0)) = False Then
MsgBox "WHOOPS! No overview sheet = error"
GoTo Skip
Else:

With Sheets(selname)
If RptLvl = "R" Then
.Shapes("ShowCustomerDataButton").Delete
.Shapes("GoToAlertsButton").Delete
End If
If RptLvl = "U" Then
.Shapes("GoToAlertsButton").Delete
End If
End With

For w = 1 To 3 'G/E/I
'only if G/E/I sheet exists
If fn_SheetExists(WSn(0, w)) = True Then
'add sheet hyperlinks as appropriate
Set WSo = Sheets(WSn(0, w))
With WSo.Range("A1")

'add Overview link
If fn_SheetExists(WSn(0, 0)) = True Then
With .Offset(0, 12)
src = "A1"
bkmk = "'" & selname & "'!A1"
txt = "Overview"
.Hyperlinks.Add _
Anchor:=.Range(src), _
Address:="", _
SubAddress:=bkmk, _
TextToDisplay:=txt
.Font.Size = 8
End With
Else:
.Offset(0, 12).Value = " "
End If

'add General link
If fn_SheetExists(WSn(0, 1)) = True Then
If Not WSo.Name = "General" Then
With .Offset(0, 13)
src = "A1"
bkmk = "'General'!A7"
txt = "General"
.Hyperlinks.Add _
Anchor:=.Range(src), _
Address:="", _
SubAddress:=bkmk, _
TextToDisplay:=txt
.Font.Size = 8
End With
End If
Else:
.Offset(0, 13).Value = " "
End If

'add Export link
If fn_SheetExists(WSn(0, 2)) = True Then
If Not WSo.Name = "Export" Then
With .Offset(0, 14)
src = "A1"
bkmk = "'Export'!A7"
txt = "Export"
.Hyperlinks.Add _
Anchor:=.Range(src), _
Address:="", _
SubAddress:=bkmk, _
TextToDisplay:=txt
.Font.Size = 8
End With
End If
Else:
.Offset(0, 14).Value = " "
End If

'add Import link
If fn_SheetExists(WSn(0, 3)) = True Then
If Not WSo.Name = "Import" Then
With .Offset(0, 15)
src = "A1"
bkmk = "'Import'!A7"
txt = "Import"
.Hyperlinks.Add _
Anchor:=.Range(src), _
Address:="", _
SubAddress:=bkmk, _
TextToDisplay:=txt
.Font.Size = 8
End With
End If
Else:
.Offset(0, 15).Value = " "
End If

'add Alerts link
If fn_SheetExists(WSn(0, 4)) = True Then
With .Offset(0, 16)
src = "A1"
bkmk = "'" & resname & "'!A1"
txt = "Alerts"
.Hyperlinks.Add _
Anchor:=.Range(src), _
Address:="", _
SubAddress:=bkmk, _
TextToDisplay:=txt
.Font.Size = 8
End With
Else:
.Offset(0, 16).Value = " "
End If

End With
End If
Next w

'select sheets
blnReplace = True 'first sheet replaces selected
For w = 0 To 4
If fn_SheetExists(WSn(0, w)) = True Then Sheets(WSn(0,
w)).Select blnReplace
blnReplace = False 'subsequent sheets add to selected array
Next w
End If

'protect and move/copy to create new WB
ActiveWindow.SelectedSheets.Move

'remember new WB name
fn = ActiveWorkbook.Name



'---------------
' DATA SHEETS
'---------------

If Not RptLvl = "B" Then GoTo SkipData '!! is this required?

WB.Activate

stn = " Data "

'commented, owing to sheet move errors
' blnReplace = True
' For Each sh In WB.Worksheets
' If InStr(1, sh.Name, stn) Then
' sh.Select blnReplace
' blnReplace = False
' End If
' Next sh
'
''move to new WB
' ActiveWindow.SelectedSheets.Copy
After:=Workbooks(fn).Sheets(Workbooks(fn).Sheets.C ount)
' WB.Activate
' ActiveWindow.SelectedSheets.Delete

For Each sh In WB.Worksheets
If InStr(1, sh.Name, stn) Then
sh.Copy After:=Workbooks(fn).Sheets(Workbooks(fn).Sheets.C ount)
sh.Delete
Else: End If
Next sh


SkipData:



'!!!!!!
'!!!!!!
'macro fails during sheets.move in the next part
'!!!!!!
'!!!!!!


'-------------------
' CUSTOMER SHEETS
'-------------------

If RptLvl = "R" Then GoTo SkipCustomer '!! is this required?

WB.Activate 'source workbook


'move any customer & drill output sheets (all contain the station/region
name or "UK")
stn = "Cust"
For Each sh In WB.Worksheets
If InStr(1, sh.Name, stn) Then sh.move
After:=Workbooks(fn).Sheets(Workbooks(fn).Sheets.C ount)
Next sh

SkipCustomer:


'-----------------
' GLOSSARY(IES)
'-----------------

Workbooks(fn).Sheets.Add After:=Sheets(Workbooks(fn).Worksheets.Count)
With ActiveSheet
.Name = "Glossary"
.Tab.ColorIndex = 1
M_M.Range("__Glossary").Copy
.PasteSpecial
.Columns("A:I").EntireColumn.AutoFit
.Columns("A").EntireColumn.Hidden = True
.Columns("C").EntireColumn.Hidden = True
.Columns("F:G").EntireColumn.Hidden = True
showallobjects 'prevents errors in hiding columns and rows
.Range(Range("IV1"), Range("IV1").End(xlToLeft).Offset(0,
1)).EntireColumn.Hidden = True
.Range(Range("A65536"), Range("A65536").End(xlUp).Offset(0,
1)).EntireRow.Hidden = True
.Range("B1").Value = "Description" 'removes the words "max width
245p"
.Range("A1").Select
End With


'-------------------
' SAVE NEW REPORT
'-------------------

'all sheets are now in new workbook "fn"
Workbooks(fn).Activate
With ActiveWorkbook

'add timestamp to overview sheet
.Sheets(selname).Range("TO_datestamp") = "Produced " & Now

'finalise all sheets in new report
Do Until w = .Sheets.Count
With .Sheets(w)
'cancel Build in Progress
If Range("A1") = "BIP" Then Range("A1") = ""
'hide customer data sheets
If InStr(1, .Name, "Cust") Then .Visible = False
'password protect with PW
.Protect Password:=PW, DrawingObjects:=True, Contents:=True,
Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True, _
AllowInsertingColumns:=True, AllowInsertingRows:=True,
AllowDeletingColumns:=True, AllowDeletingRows:=True, _
AllowSorting:=True, AllowFiltering:=True,
AllowUsingPivotTables:=True
'set focus on all sheets to A1
'.Range("A1").Select
End With
w = w + 1
Loop

'hide sheet tabs
ActiveWindow.TabRatio = 0


'save new report to (shared drive)
'path has generic format "\\UKOV\RGN\BSTN\"
If RptLvl = "B" Then
'set new fn before save: "STN YYYY-MM" (len 11)
fn = Right(selname, 11) & ".xls"
'set path (testing will save to My Docs, may eventually need to swap for
production lookup from M_R)
Dim path As String
path = M_M.Range("_PATH_reports") _
& WorksheetFunction.Index(M_S.Range("StnRReport"),
WorksheetFunction.Match(BR, M_S.Range("StnBSTN"), 0)) & "\" _
& BR & "\"
ElseIf RptLvl = "R" Then
fn = Right(selname, 12) & ".xls"
path = M_M.Range("_PATH_reports") _
& BR & "\"
ElseIf BR = "UKOV" Then
fn = Right(selname, 12) & ".xls"
path = M_M.Range("_PATH_reports")
End If
.Sheets(1).Select
.SaveAs Filename:=path & fn
.Close

End With

SkipSave:


Skip:
End Sub