Untitled

Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpDest As LongPtr, ByVal lpSource As String) As Long

Public Sub ConcatenateAndCopy()
    Dim cell As Range
    Dim concatenated As String
    Dim separator As String
    separator = "," ' Define your separator here, e.g., comma without space
    
    ' Check if any cells are selected
    If TypeName(Selection) <> "Range" Then
        MsgBox "Please select a range of cells first", vbExclamation
        Exit Sub
    End If
    
    ' Loop through each cell in the selection and build the concatenated string
    For Each cell In Selection
        If cell.Value <> "" Then
            concatenated = concatenated & cell.Text & separator
        End If
    Next cell
    
    ' Remove the last separator
    If Len(concatenated) > 0 Then
        concatenated = Left(concatenated, Len(concatenated) - Len(separator))
    End If
    
    ' Copy the concatenated string to the clipboard
    CopyTextToClipboard concatenated
End Sub

Public Sub CopyTextToClipboard(ByVal Text As String)
    Dim hMem As LongPtr
    Dim lpMem As LongPtr

    ' Allocate global memory for the text
    hMem = GlobalAlloc(&H42, Len(Text) + 1)
    ' Lock the block to get a pointer to the memory
    lpMem = GlobalLock(hMem)
    ' Copy the string to the global memory
    lpMem = lstrcpy(lpMem, Text)
    ' Unlock the memory
    GlobalUnlock (hMem)

    ' Open the Clipboard to empty it and set the new text
    If OpenClipboard(0&) Then
        Call EmptyClipboard
        Call SetClipboardData(1, hMem)
        Call CloseClipboard
    End If
End Sub