Hi
I have written this below but when it runs after going through the message boxes, copies the sheet UKAS but always gets a runtime error 9 subscript out of range at the line
Windows("Pressure Cert.xls").Activate
at the bottom end of the code.
Sub ukascert()
'
' Macro29 Macro
' Macro recorded 03/09/2006 by wsmith
'
'
Application.ScreenUpdating = False
ActiveWorkbook.Unprotect Password:="ws"
Sheets("Sheet2").Visible = True
Sheets("Sheet2").Select
ActiveSheet.Unprotect Password:="ws"
Let m = Range("E5")
Let n = Range("I6")
Let b = Range("B18")
Let v = Range("C4")
Let c = Range("D4")
ActiveSheet.Protect Password:="ws"
Sheets("Sheet2").Visible = False
If m <> "Select Fluid" Then
If n <> "None" Then
If b <> "Select" Then
If v <> "Select" Then
If c <> "Select" Then
Sheets("Sheet3").Visible = True
Sheets("Sheet3").Select
ActiveSheet.Unprotect Password:="ws"
Rem get number of points used
Let np = Range("A120")
ActiveSheet.Protect Password:="ws"
Sheets("Sheet3").Visible = False
Sheets("Data Input Sheet").Select
Range("B2").Select
If np = True Then
Sheets("UKAS 4-20").Visible = True
Sheets("UKAS 4-20").Select
ActiveSheet.Unprotect Password:="ws"
Range("A1:J93").Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWindow.DisplayGridlines = False
ActiveWindow.View = xlPageBreakPreview
Application.CutCopyMode = False
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
ActiveWindow.SmallScroll Down:=18
Range("E38").Select
ActiveWindow.Zoom = 85
ActiveWindow.Zoom = 100
ActiveWindow.Zoom = 115
ActiveWindow.Zoom = 130
Set ActiveSheet.HPageBreaks(1).Location = Range("A53")
ActiveWindow.SmallScroll Down:=-57
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(1.33858267716535)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.Zoom = 92
End With
Range("C13").Select
ActiveSheet.Protect Password:="ws"
Windows("Pressure Cert.xls").Activate
Sheets("UKAS 4-20").Select
ActiveSheet.Protect Password:="ws"
Sheets("UKAS 4-20").Visible = False
Sheets("Data Input Sheet").Select
Range("B2").Select
ActiveWorkbook.Protect Password:="ws"
Else
Sheets("UKAS").Visible = True
Sheets("UKAS").Select
ActiveSheet.Unprotect Password:="ws"
Range("A1:J93").Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWindow.DisplayGridlines = False
ActiveWindow.View = xlPageBreakPreview
Application.CutCopyMode = False
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
ActiveWindow.SmallScroll Down:=18
Range("E38").Select
ActiveWindow.Zoom = 85
ActiveWindow.Zoom = 100
ActiveWindow.Zoom = 115
ActiveWindow.Zoom = 130
Set ActiveSheet.HPageBreaks(1).Location = Range("A53")
ActiveWindow.SmallScroll Down:=-57
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(1.33858267716535)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.Zoom = 92
End With
Range("C13").Select
ActiveSheet.Protect Password:="ws"
Windows("Pressure Cert.xls").Activate
Sheets("UKAS").Select
ActiveSheet.Protect Password:="ws"
Sheets("UKAS").Visible = False
Sheets("Data Input Sheet").Select
Range("B2").Select
ActiveWorkbook.Protect Password:="ws"
End If
Else
Call MyMessage5
End If
Else
Call MyMessage4
End If
Else
Call MyMessage3
End If
Else
Call MyMessage2
End If
Else
Call MyMessage1
End If
Sheets("Data Input Sheet").Select
Application.ScreenUpdating = True
End Sub
Bookmarks