Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim cmdBarBut As CommandBarButton
    On Error Resume Next
With Application
    .CommandBars("cell").Controls("сцепить_запятая").Delete
    Set cmdBarBut = .CommandBars("cell").Controls.Add(Temporary:=True)
End With
        With cmdBarBut
            .Caption = "сцепить_запятая"
            .Style = msoButtonCaption
            .OnAction = "сцепить_запятая"
        End With
    On Error GoTo 0
End Sub

Sub Сцепить_запятая()
Dim D As Range, R As String, BP As Boolean
Dim avData, lr As Long, lc As Long, sRes As String
Dim oDict As Object, sTmpStr
Dim Scm As New DataObject
    Set oDict = CreateObject("Scripting.Dictionary")
    oDict.comparemode = 1
    Set D = Selection
    avData = D.Value
    R = ","
    If Not IsArray(avData) Then
        Scm = avData
        Exit Sub
    End If
 
    For lc = 1 To UBound(avData, 2)
        For lr = 1 To UBound(avData, 1)
            If Len(avData(lr, lc)) Then
                sRes = sRes & R & avData(lr, lc)
                If БезПовторов Then
                    If Not oDict.exists(avData(lr, lc)) Then
                        oDict.Add avData(lr, lc), 0&
                    End If
                End If
            End If
        Next lr
    Next lc
    If Len(sRes) Then
        sRes = Mid(sRes, Len(R) + 1)
    End If
 
    If BP Then
        sRes = ""
        sTmpStr = oDict.keys
        For lr = LBound(sTmpStr) To UBound(sTmpStr)
            sRes = sRes & IIf(sRes <> "", R, "") & sTmpStr(lr)
        Next lr
    End If
Scm.SetText (sRes)
Scm.PutInClipboard
    MsgBox ("Значение" & sRes & vbCr & "скопировано в буфер")
End Sub