試圖運行宏時收到錯誤消息

Question

我已經完成了我的VBA並嘗試運行它。當我從代碼窗口進入並按F5時，它會運行，但是當我嘗試使用實際工作簿中的按鈕時，我得到「無法運行宏。宏可能在此工作簿中不可用或者所有宏可能禁用「。

'Activating Sheet2 in EMM_Template 
    Sheets("Sheet2").Activate 

'Deleting Column E (Prod RICC) 
    Sheets("Sheet2").Columns(5).EntireColumn.Delete 

'Deleting Row 3 (Title Row) 
    Sheets("Sheet2").Rows(3).EntireRow.Delete 

'Selecting Range 
    Sheets("Sheet2").Range("A3").CurrentRegion.Select 

'Changing Font To Calibri 10 
    With Sheets("Sheet2").Range("A3").CurrentRegion 
     With .Font 
      .Name = "Calibri" 
      .Size = 10 
     End With 
    End With 

With Sheets("Sheet2") 
    For Lrow = 1 To ActiveSheet.UsedRange.Rows.Count 
      With .Cells(Lrow, "M") 
       If Not IsError(.Value) Then 
        If .Value = "FUTURE" Then 
         .EntireRow.Delete 
        End If 
       End If 
      End With 
    Next Lrow 
End With 

'Copying from Sheet2 
'Activating/Pasting EMM_ETF 
    Sheets("Sheet2").Range("A3").CurrentRegion.Copy 
    Sheets("EMM ETF").Activate 
    Sheets("EMM ETF").Range("A3").Select 
    Sheets("EMM ETF").Rows("3:3").Insert shift:=xlDown 

'Format Data 
    Sheets("EMM ETF").Range("A3").CurrentRegion.Select 
      Range("A3").CurrentRegion.Rows.RowHeight = 12.75 
      Range("A3").CurrentRegion.Columns.ColumnWidth = 12 

      Rows("1:1").EntireRow.AutoFit 
      Rows("2:2").EntireRow.AutoFit 

       With Sheets("EMM ETF").Rows("2:2").EntireRow 
        With .Font 
         .Size = 10 
        End With 
       End With 





'Deleting 0's from Col FGH 
     For i = 1 To ActiveSheet.UsedRange.Rows.Count 
       If Trim((Cells(i, 13).Value)) = "CURNCY" Then 
         Cells(i, 6).Delete shift:=xlToLeft 
         Cells(i, 6).Delete shift:=xlToLeft 
         Cells(i, 6).Delete shift:=xlToLeft 
       End If 

     Next i 

'Deleting 0's from Col IJK 
     For i = 1 To ActiveSheet.UsedRange.Rows.Count 
       If Trim((Cells(i, 13).Value)) = "STOCK" Then 
         Cells(i, 9).Delete shift:=xlToLeft 
         Cells(i, 9).Delete shift:=xlToLeft 
         Cells(i, 9).Delete shift:=xlToLeft 
       End If 
     Next i 

'Insert Column to for Action Autofill 
    Sheets("EMM ETF").Range(Range("J3:L3"), Range("J3:L3").End(xlDown)).Select 
    Sheets("EMM ETF").Range(Range("J3:L3"), Range("J3:L3").End(xlDown)).Cut 
    Sheets("EMM ETF").Range("K3").Select 
    ActiveSheet.Paste 


'Match Action Rights to Last Comment 
Dim Rng As Range, x As Range 

     With ActiveSheet 

      Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row) 
        For Each x In Rng 

        If InStr(1, x.Text, "No Action", 1) > 0 Then 
        x.Offset(0, 1).Value = "No Action" 

        End If 

        Next x 





      Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row) 
        For Each x In Rng 

        If InStr(1, x.Text, "Rights", 1) > 0 Then 
        x.Offset(0, 1).Value = "Rights" 

        End If 

        Next 




       Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row) 
       For Each x In Rng 

        If InStr(1, x.Text, "Warrant", 1) > 0 Then 
        x.Offset(0, 1).Value = "Warrant" 

        End If 



        Next x 



       Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row) 
       For Each x In Rng 

        If InStr(1, x.Text, "Pinksheet", 1) > 0 Then 
        x.Offset(0, 1).Value = "Pinksheet" 

        End If 



        Next x 



       Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row) 
       For Each x In Rng 

        If InStr(1, x.Text, "Desk", 1) > 0 Then 
        x.Offset(0, 1).Value = "Desk to adjust" 

        End If 



        Next x 



       Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row) 
       For Each x In Rng 

        If InStr(1, x.Text, "Asset", 1) > 0 Then 
        x.Offset(0, 1).Value = "Asset Servicing" 

       End If 

       Next x 



       Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row) 
       For Each x In Rng 

        If InStr(1, x.Text, "Journal", 1) > 0 Then 
        x.Offset(0, 1).Value = "MO Journal" 

       End If 

       Next x 

     End With 


'Detect/Cut/Insert/CCY 
     Dim CorrectPosition As Integer 

     CorrectPosition = getCorrectPosition("Ccy") 
     Call MoveRows("K", "CURNCY", CorrectPosition) 

     'Detect/Cut/Insert/Foreign 
     CorrectPosition = getCorrectPosition("Foreign") 
     Call MoveRows("A", "FRGN3", CorrectPosition) 

'Changing Font To Calibri 10 
    With Sheets("EMM ETF").Range("A3").CurrentRegion 
     With .Font 
      .Name = "Calibri" 
      .Size = 10 
     End With 
    End With 

'Final Sort 


End Sub 

Function getCorrectPosition(StringToLookFor As String) As Integer 
Dim i As Integer 
For i = 3 To ActiveSheet.UsedRange.Rows.Count 
    If (Cells(i, 1) = StringToLookFor) Then 
     Exit For 
    End If 
Next 

getCorrectPosition = i + 2 
End Function 

Sub MoveRows(columnName As String, LookupValue As String, positionToPaste As Integer) 
     With Sheets("EMM ETF") 
      For Lrow = 2 To ActiveSheet.UsedRange.Rows.Count 
        With .Cells(Lrow, columnName) 
         If Not IsError(.Value) Then 
          If .Value = LookupValue Then 
           .EntireRow.Cut 
           Cells(positionToPaste, 1).Select 
           Selection.Insert shift:=xlDown 
           Lrow = 1 
          ElseIf .Value = "" Then 
           Exit For 

          End If 

         End If 
        End With 
      Next Lrow 
     End With 


End Sub 

Answer 1

您可能必須將工作簿保存爲啓用宏的工作簿，然後重新打開它。如果提示啓用宏，請單擊確定。