Problemas macro el código de cada hoja al ponerlo en Thisworkbook

Al quitar esta macro de la hoja de cada cliente y ponerla en Thisworkbook :

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Select Case Sh.Name
Case "Contado", "Adra Paco", "Balerma Trini", "El Ejido Adelina", "Berja Gador", "Adra Maria", "Iznajar Pepa", "Lucena Rafaela", "Lucena Carmen",
"Benameji Juan", "Badolatosa Mª Jose", "Casariche Carmen", "Gilena Aurelia", "F. Piedra Antonia", "Humilladero Victoria", "Benameji Sole", "Galerias
Fernandez", "Fuengirola Paco", "Fuengirola Charo", "Fuengirola Rosalia", "La Cala Antonia", "Marbella Juani", "Marbella Sara", "Flores Carmen", "Asuncion
Maria", "Asuncion Pepi", "Asuncion Inma", "Asuncion Maria", "Asuncion Pepi", "Asuncion Inma", "Delicias Amparo", "La Paz Cris", "La Paz Paco", "La Luz J.
Manuel", "Chapas Virginia Toñi", "P Sur Toñi", "Molinillo Meli", "Union Ramona Gema", "Huetor Mª Luisa", "Salar Carmen", "Loja Maribel", "Loja Paqui", "Loja
Paqui", "Loja Mª Jose", "Moraleda Paqui", "Loja Pepa Marengo", "V Trabuco Charo", "A. Miel Manolo", "A. Miel Conchi Tere", "Torremolinos Paqui",
"Torremolinos Fina", "Churriana Eva", "Pima", "Viajante PACO", "Viajante ORTIGOSA"
If Not Application.Intersect(Target, Range("F12:F41")) Is Nothing Then
Cancel = True
Set rMiCelda = Target
Call Crear_PopUp
CommandBars("Clientes").ShowPopup
End If
ActiveSheet.Protect Password:="1"
End Select
End Sub

En la linea 

CommandBars("Clientes").ShowPopup

me da error de depurar, y esto corresponde a unas macros que estan en un modulo y es :

Const Nombre_PopUp As String = "Clientes"
Public rMiCelda As Range
Sub Crear_PopUp()
Dim cb As CommandBar
Dim sTexto As String
Call DeletePopUp
Application.ErrorCheckingOptions.BackgroundChecking = False
Set cb = CommandBars.Add(Nombre_PopUp, msoBarPopup, False, True)
With cb
sTexto = Worksheets("Listado").Range("F6").Value & " " & Worksheets("Listado").Range("F7").Value
sTexto = StrConv(sTexto, vbProperCase)
With .Controls.Add(Type:=msoControlButton)
.OnAction = "Modificar_Formula_01"
.FaceId = 71
.Caption = sTexto
End With
sTexto = Worksheets("Listado").Range("G6").Value & " " & Worksheets("Listado").Range("G7").Value
sTexto = StrConv(sTexto, vbProperCase)
With .Controls.Add(Type:=msoControlButton)
.OnAction = "Modificar_Formula_02"
.FaceId = 72
.Caption = sTexto
End With
sTexto = Worksheets("Listado").Range("H6").Value & " " & Worksheets("Listado").Range("H7").Value
sTexto = StrConv(sTexto, vbProperCase)
With .Controls.Add(Type:=msoControlButton)
.BeginGroup = True
.OnAction = "Modificar_Formula_03"
.FaceId = 73
.Caption = sTexto
End With
sTexto = Worksheets("Listado").Range("P6").Value & " " & Worksheets("Listado").Range("P7").Value
sTexto = StrConv(sTexto, vbProperCase)
With .Controls.Add(Type:=msoControlButton)
.BeginGroup = True
.OnAction = "Modificar_Formula_06"
.FaceId = 74
.Caption = sTexto
End With
End With
Set cb = Nothing
End Sub
Sub DeletePopUp()
On Error Resume Next
CommandBars(Nombre_PopUp).Delete
End Sub
Sub Modificar_Formula_01()
Call Modificar_Formula(3, rMiCelda)
End Sub
Sub Modificar_Formula_02()
Call Modificar_Formula(4, rMiCelda)
End Sub
Sub Modificar_Formula_03()
Call Modificar_Formula(5, rMiCelda)
End Sub
Sub Modificar_Formula_06()
Call Modificar_Formula(13, rMiCelda)
End Sub
Private Sub Modificar_Formula(ByVal nColumna As Integer, ByVal Target As Range)
ActiveSheet.Unprotect Password:="1"
Target.FormulaR1C1 = _
"=IF(RC3<>"""",VLOOKUP(RC3,tblArticulos," & nColumna & ",FALSE),"""")"
End Sub

Lo que hace es que en cada página de los clientes es que en el rango :

Range("F12:F41")

Me da opción de poner un precio de cuatro opciones

Gracias por las molestias