Макрос Excel не работает при запуске из личной книги

Question

Я новичок в VBA и пытаюсь создать макрос, который избавился бы от нескольких строк на основе определенных критериев. Макрос отлично работает, когда я запускаю его из книги, но не работает, когда я пытаюсь запустить его из личной книги. Я хочу иметь возможность использовать макрос со всеми видами электронных таблиц, которые я получаю на работе. Я помещаю управляющее сообщение, чтобы сообщить мне, выполняется ли макрос в активной книге, а не в личной, и оно показывает, что он выполняется в активной книге. Вот код:

Sub Delete_Unused_Rows()

Dim lRows As Long
Dim vbAnswer As VbMsgBoxResult
Dim sCriteria1 As Variant
Dim sCriteria2 As Variant
Dim sCriteria3 As Variant
Dim sCriteria4 As Variant
Dim sCriteria5 As Variant
Dim ImportantData1 As Variant
Dim ImportantData2 As Variant
Dim ImportantData3 As Variant
Dim ImportantData4 As Variant
Dim ImportantData5 As Variant
Dim Company_Name

With ActiveWorkbook.ActiveSheet

MsgBox "The name of the active sheet is " & ActiveWorkbook.Name & ActiveSheet.Name

  'Ask user for input
  sCriteria1 = Application.InputBox(Prompt:="Please enter the criteria for 1-30 days." _
                                    & vbNewLine & "Type and Integer.", _
                                    Title:="Little Macro", _
                                    Type:=1)
'Exit if user presses Cancel button
  If sCriteria1 = False Then Exit Sub

  sCriteria2 = Application.InputBox(Prompt:="Please enter the filter criteria for 31-60 days." _
                                    & vbNewLine & "Type and Integer.", _
                                    Title:="Little Macro", _
                                    Type:=1)
'Exit if user presses Cancel button
  If sCriteria2 = False Then Exit Sub

  sCriteria3 = Application.InputBox(Prompt:="Please enter the filter criteria for 60-90 days." _
                                    & vbNewLine & "Type and Integer.", _
                                    Title:="Little Macro", _
                                    Type:=1)
'Exit if user presses Cancel button
  If sCriteria3 = False Then Exit Sub

  sCriteria4 = Application.InputBox(Prompt:="Please enter the criteria for 91-120 days." _
                                    & vbNewLine & "Type and Integer.", _
                                    Title:="Little Macro", _
                                    Type:=1)
'Exit if user presses Cancel button
  If sCriteria4 = False Then Exit Sub

  sCriteria5 = Application.InputBox(Prompt:="Please enter the filter criteria for 120 + days." _
                                    & vbNewLine & "Type and Integer.", _
                                    Title:="Little Macro", _
                                    Type:=1)
'Exit if user presses Cancel button
  If sCriteria5 = False Then Exit Sub

row_number = 1


    Do
    'DoEvents
        row_number = row_number + 1
        Company_Name = Sheet1.Range("A" & row_number)
        ImportantData1 = Sheet1.Range("E" & row_number)
        ImportantData2 = Sheet1.Range("F" & row_number)
        ImportantData3 = Sheet1.Range("G" & row_number)
        ImportantData4 = Sheet1.Range("H" & row_number)
        ImportantData5 = Sheet1.Range("I" & row_number)


        If ImportantData1 >= sCriteria1 Then
            With Range("E" & row_number).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
            End With
            Range("E" & row_number).Font.Bold = True
        End If

         If ImportantData2 >= sCriteria2 Then
            With Range("F" & row_number).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
            End With
            Range("F" & row_number).Font.Bold = True
        End If

         If ImportantData3 >= sCriteria3 Then
            With Range("G" & row_number).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
            End With
            Range("G" & row_number).Font.Bold = True
        End If

         If ImportantData4 >= sCriteria4 Then
            With Range("H" & row_number).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
            End With
            Range("H" & row_number).Font.Bold = True
        End If

         If ImportantData5 >= sCriteria5 Then
            With Range("I" & row_number).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
            End With
            Range("I" & row_number).Font.Bold = True
        End If


        If ImportantData1 < sCriteria1 And ImportantData2 < sCriteria2 And ImportantData3 < sCriteria3 And ImportantData4 < sCriteria4 And ImportantData5 < sCriteria5 Then
            Sheet1.Rows(row_number & ":" & row_number).Delete
            row_number = row_number - 1
        End If

       ' If IsEmpty(Company_Name) = True Then
       '  Exit Do
       ' End If

    Loop Until Company_Name = Empty

MsgBox "Completed"

End With

End Sub

Вот как выглядит электронная таблица:

Spreadsheet Sample.jpg

Любая помощь приветствуется