尝试运行宏时收到错误消息

时间:2015-10-06 14:25:53

标签: excel vba excel-vba

我已经完成了我的VBA,我正在尝试运行它。当我进入并从代码窗口按F5时,它会运行,但是当我尝试使用实际工作簿中的按钮时,我得到了#34;无法运行宏。宏可能在此工作簿中不可用,或者可能禁用所有宏。"

'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

1 个答案:

答案 0 :(得分:0)

您可能必须将工作簿另存为启用宏的工作簿,然后重新打开它。如果提示启用宏,请单击“确定”。