我的excel VBA中的代码存在问题，该问题适用于excel 97但不适用于excel 16

Question

我有一个我编写的代码，它在excel 97中的电子表格中工作，但在2016年没有...代码意味着将数据表拆分为3个名为.....的部分。 _Haz1 ...... _ Haz2 ...... _ Haz3 .....

每列中的每个项目旁边都有复选框，这是一张风险评估表，当代码运行时，它应该将所有勾选的项目放在下面的表格中。

我已经创建了一个按钮并将宏连接到按钮上，所以当你点击按钮时它会运行那个特定的宏......

当我点击按钮时，它会运行它向下移动的代码，好像这些项目被放入下面的表格中但是我只是在表格中得到一条粗蓝线和ni项......

我感到困惑的是它在之前的excel 1997中有效，但在excel 2016中没有用

Option Explicit

Public iHazCount

Sub CompileHazards()

   iHazCount = 0

   Application.ScreenUpdating = False

   Call ClearCompileArea

   Call FetchHazards(Range("Hazards!Haz1"), -3)
   Call FetchHazards(Range("Hazards!Haz2"), -4)
   Call FetchHazards(Range("Hazards!Haz3"), -7)

   ' set print area
   ActiveSheet.PageSetup.PrintArea = "$A$1:$Q$" & 80 + iHazCount

   Application.Goto Reference:=Range("A91"), Scroll:=True

   Application.ScreenUpdating = True

End Sub

Sub FetchHazards(rHazList As Range, iDataOffset As Integer)

   Dim rHazCell As Range

   Dim iCurrRow As Integer

   For Each rHazCell In rHazList
      If rHazCell.Value = True Then
         ' calculate row postion
         iCurrRow = 81 + iHazCount
         ' first add line
         ' select bottom blank line and copy it down
          Range("A" & iCurrRow & ":Q" & 82 + iHazCount).Select
          Selection.Copy
          Range("A" & iCurrRow + 1).Select
          ActiveSheet.Paste
          ' go back to orig blank line and change blue bottom border
          Range("A" & iCurrRow & ":Q" & iCurrRow).Select
          Application.CutCopyMode = False
          With Selection.Borders(xlEdgeBottom)
              .LineStyle = xlContinuous
              .Weight = xlThin
              .ColorIndex = xlAutomatic
          End With
         ' copy hazard
         Range("A" & iCurrRow).Value = rHazCell.Offset(0, iDataOffset).Value
         ' insert risk formula
         Range("P" & iCurrRow).Formula = "=IF(N" & iCurrRow & "*O" & iCurrRow & "< 7,""LOW"",IF(N" & iCurrRow & "*O" & iCurrRow & "< 11 ,""MID"",""HIGH""))"
         ' increment line count
         iHazCount = iHazCount + 1

      End If
   Next

End Sub

Sub ClearCompileArea()

   ' delete all rows below first
    Rows("83:121").Select
    Selection.Delete Shift:=xlUp
    ' clear contents of first row
    Range("A81:Q81").Select
    Selection.ClearContents
    ' reinsert blue bottom border
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 5
    End With

End Sub