I want to copy multiple cells as one sentence to paste in another program

[Limeskin]

Hey,

I'm looking to create a table with pre-determined sentences in, so that all I need to do is add a person's name in the middle cell, and hit copy on a command button, and I will have copied the multiple cells, to be able to copy as one sentence in another program elsewhere.

I have found a code that lets me use VBA macros (sorry I'm new to all this so my language may be incorrectly used here). It seems to work, and I have posted this below:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim xSheet As Worksheet
Set xSheet = ActiveSheet
If xSheet.Name <> "Definitions" And xSheet.Name <> "fx" And xSheet.Name <> "Needs" Then
xSheet.Range("A1:C17 ").Copy
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If

Application.ScreenUpdating = True
End Sub

It's handy as it lets me just change the cell range and I am good to go.

How do I stop it from copying the formatting? If I made a range of say A1:C1, I find that what ever is written into B1 has large gaps between it, where as I want it to read as a sentence with no large gaps, just one line. (cells A1 and C1 will have fixed text in them that I plan to lock, so that all I need to do is add a name into B1 and hit the command button to copy everything as one sentence. This is to save me writing out the same sentence for different people over and over again).

Can anyone help? It's not a massive issue but I'm trying to fine tune what I'm looking for so that it doesn't have big gaps. Just everything as one text.

Thanks.
Lime

 

[Limeskin]

The API declarations are not correct and the code won't work in x64bit excel.

Here is the correct code :

Option Explicit

#If VBA7 Then
    Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
    Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
    Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
    Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
    Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
#Else
    Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
    Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Declare Function CloseClipboard Lib "user32" () As Long
    Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function EmptyClipboard Lib "user32" () As Long
    Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
    Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
#End If

Const GHND = &H42
Const CF_TEXT = 1
Const MAXSIZE = 4096

Public Function ClipBoard_SetData(sPutToClip As String) As Boolean

    ' www.msdn.microsoft.com/en-us/library/office/ff192913.aspx
    #If Win64 Then
        Dim hGlobalMemory As LongLong, lpGlobalMemory As LongLong, hClipMemory As LongLong
    #Else
        Dim hGlobalMemory As Long, lpGlobalMemory As Long, hClipMemory As Long
    #End If
 
    Dim x As Long
 
    On Error GoTo ExitWithError_

    ' Allocate moveable global memory
    hGlobalMemory = GlobalAlloc(GHND, Len(sPutToClip) + 1)

    ' Lock the block to get a far pointer to this memory
    lpGlobalMemory = GlobalLock(hGlobalMemory)

    ' Copy the string to this global memory
    lpGlobalMemory = lstrcpy(lpGlobalMemory, sPutToClip)

    ' Unlock the memory
    If GlobalUnlock(hGlobalMemory) <> 0 Then
        MsgBox "Memory location could not be unlocked. Clipboard copy aborted", vbCritical, "API Clipboard Copy"
        GoTo ExitWithError_
    End If

    ' Open the Clipboard to copy data to
    If OpenClipboard(0&) = 0 Then
        MsgBox "Clipboard could not be opened. Copy aborted!", vbCritical, "API Clipboard Copy"
        GoTo ExitWithError_
    End If

    ' Clear the Clipboard
    x = EmptyClipboard()

    ' Copy the data to the Clipboard
    hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
    ClipBoard_SetData = True
 
    If CloseClipboard() = 0 Then
        MsgBox "Clipboard could not be closed!", vbCritical, "API Clipboard Copy"
    End If
    Exit Function
ExitWithError_:
    On Error Resume Next
    If Err.Number > 0 Then MsgBox "Clipboard error: " & Err.Description, vbCritical, "API Clipboard Copy"
    ClipBoard_SetData = False

End Function

I tried the new code with no success but I think that's due to my lack of knowledge on Vba's. Think the codes went to the right places like.

 

[Micron]

What is the bit version of your Office programs (not the bit version of Windows)? I have 32 bit Excel and what I posted worked for me.

 

[Jaafar Tribak]

I tried the new code with no success but I think that's due to my lack of knowledge on Vba's. Think the codes went to the right places like.

Just add a new Standard Module to you vb project and place the code in it.

After that , add the following macro (offered by Micron) to another standard module and run it.

Sub ConcatCells()

    Dim ws As Worksheet
    Dim strOut As String
   
    Set ws = ThisWorkbook.Sheets("Sheet2") '<<change this to your sheet name
    strOut = strOut & ws.Range("A1") & ws.Range("B1") & ws.Range("C1") 'make sure that this is your range of 3 cells
    'Debug.Print strOut
    ClipBoard_SetData strOut '<<this calls ClipBoard_SetData function and puts strOut on the clipboard

End Sub

Once you have executed the above ConcatCells Macro, the concatenated values of cells A1,B1,C1 in sheet2 should be placed in the clipboard ready for pasting.

 

[Jaafar Tribak]

What is the bit version of your Office programs (not the bit version of Windows)? I have 32 bit Excel and what I posted worked for me.

Yes, it should work fine in x32bit versions of excel but will fail in excel x64bit because memory handles in x64bit are LongLong