If you mean the popup menu; try the below

On the active sheet Range("A1:A10") type some values say 1 to 10 and run the
below macro..

Sub Macro()
Dim cell As Range
Dim cbCTLPop As CommandBarPopup, cbCTLBut As CommandBarButton

On Error Resume Next
Application.CommandBars("MyBar").Delete
Application.CommandBars.Add "MyBar", Position:=msoBarPopup, _
Temporary:=True

Set cbCTLPop = Application.CommandBars("MyBar").Controls.Add( _
Type:=msoControlPopup, Temporary:=True)
cbCTLPop.Caption = "My menu"

For Each cell In Range("A1:A10")
Set cbCTLBut = cbCTLPop.Controls.Add(Temporary:=True)
With cbCTLBut
.Caption = cell.Text
.Style = msoButtonCaption
.OnAction = "Macro_" & cell.Text
End With
Set cbCTLBut = Nothing
Next
Application.CommandBars("MyBar").ShowPopup
End Sub

If this post helps click Yes
---------------
Jacob Skaria


"caveman.savant" wrote:

I've copied some text in the clipboard and then using the macro below
copy each item into a separate row.


Sub CommandButton2_Click()

Dim MyData As New DataObject
Dim strClip As String
On Error GoTo NotText
MyData.GetFromClipboard
strClip = MyData.GetText
Range("A1").Select
ActiveSheet.PasteSpecial Format:="Text", Link:=False,
DisplayAsIcon:= _
False

Rows("2:2").Select
Selection.Copy

Sheets("Results").Select
Application.Goto Reference:="R1C1"
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=True

Application.Goto Reference:="R1C1"
ActiveCell.FormulaR1C1 = " " + ActiveCell.FormulaR1C1
' Range("B1").Select

NotText:
'don't want anything to happen if the clipboard is empty
End Sub


Next I need to select the pasted text as a range and to copy
=IF(ISNUMBER(VALUE(LEFT((A1),FIND(" ",TRIM(A1))))),VALUE(LEFT((A1),FIND
(" ",TRIM(A1)))),1)
into the second column of each row

and this in the 3rd column
=TRIM(MID(TRIM(A1),FIND(" ",TRIM(A1)),LEN(A1)))

I'm tryng to use
Set MyRange = Range((Cells(xlFirstRow, xlFirstCol)), (Cells
(xlLastRow, xlLastCol)))
MyRange.Copy Destination:=Sheets("Sheet2").Range("B4")