select cells and create string

[censura]

Hi a excel expert on here kindly provided the code below, I select cells by clicking into cells then right click and then paste string into another cell.

Only thing is the output shows ()|()|()|() it is not picking up contents of each cell can anyone see if i am doing something wrong or there is an issue with the code - thank you

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

'# Note that you must enable Tools > References > Microsoft Forms 2.0 Object Library

'#
'# declare
'#
    Dim strOutput As String
    Dim lngColumnNumber As Long
    Dim lngRowNumber As Long
    Dim wsActive As Worksheet
    Dim objData As New DataObject
    
'#
'# initialize
'#
    Set wsActive = Target.Parent
    
'#
'# build output string
'#
    With wsActive
        For lngColumnNumber = Target.Column To (Target.Column + Target.Columns.Count)
            For lngRowNumber = Target.Row To (Target.Row + Target.Rows.Count)
                strOutput = strOutput & "|" & .Cells(1, lngColumnNumber).Value & "(" & .Cells(lngRowNumber, lngColumnNumber).Value & ")"
            Next lngRowNumber
        Next lngColumnNumber
    End With
    
'#
'# copy string to the clipboard
'#
    objData.SetText Mid$(strOutput, 2)
    objData.PutInClipboard
    Set objData = Nothing
        
'#
'# cancel the right click event
'#
    Cancel = True
    
End Sub