Does this work?

Code:
Sub renameMac()
    Dim macCount As Integer
    Dim i As Integer
    Dim newName As String
    newName = InputBox("Enter new name for macro")
    macCount = CurrentProject.AllMacros.Count
    For i = 1 To macCount
        If CurrentProject.AllMacros(i).Name = "macOriginal" Then
            DoCmd.Rename newName, acMacro, "macOriginal"
            Exit Sub
        End If
    Next i
End Sub