Problem
When I copy paste content from Excel sheet to an outside program (say notepad++), double quotes are added automatically in entire cell data. This issue occurs only when copying multi-line content in a cell.
Solution
This problem can be solved by linking a visual basic script (Macros) the excel
2. Open Visual Basic for Application by pressing Alt+F11
3. From the left tab, you can select where you want to apply the VB script
If you want to add script only on a single sheet of Excel, open the required sheet name. If you want this script in entire sheet, open ThisWorkbook
4. Paste following code in the opened window
Option Explicit
Private Declare Function OpenClipboard Lib "user32.dll" ( _
ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function SetClipboardData Lib "user32.dll" ( _
ByVal wFormat As Long, _
ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" ( _
ByVal wFlags As Long, _
ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" ( _
ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" ( _
ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32.dll" ( _
ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" ( _
ByVal lpStr1 As Any, _
ByVal lpStr2 As Any) As Long
Private Const CF_TEXT As Long = 1&
Private Const GMEM_MOVEABLE As Long = 2
Sub CopyContent()
Call StringToClipboard(ActiveCell.Value)
End Sub
Private Sub StringToClipboard(strText As String)
Dim lngIdentifier As Long, lngPointer As Long
lngIdentifier = GlobalAlloc(GMEM_MOVEABLE, Len(strText) + 1)
lngPointer = GlobalLock(lngIdentifier)
Call lstrcpy(ByVal lngPointer, strText)
Call GlobalUnlock(lngIdentifier)
Call OpenClipboard(0&)
Call EmptyClipboard
Call SetClipboardData(CF_TEXT, lngIdentifier)
Call CloseClipboard
Call GlobalFree(lngIdentifier)
End Sub
5. Save the VBA script
6. Now got View > Macros > View Macros
7. Select the saved Macros and click Options
Add a shortcut key for the Macro (for example, add Ctrl + q). Then close Macro
8. Now select the content you want to copy. Press Ctrl+q for copying. Now you can successfully paste content without the annoying double quotes problem.
Backup Solution
If you do not need copy regularly from Excel, here is the simple solution for you. First copy paste content from Excel into Word document (use Ctrl+V for pasting or use Merge Formatting in Paste Options). Then you can copy paste the same from the word document into the other program (notepad++). It will appear without the quotes.
The above code is adapted from the code given in the following website
http://www.herber.de/forum/archiv/1424to1428/1426787_DataObject__PutInClipboard_funktioniert_nicht.html
5 Comments
I need this in multiple cells not just one cell. Please help.
ReplyDeletenot good for 64 bit
ReplyDeleteAny seloution for 64 bit
ReplyDeleteFor 64 bit version, try this:
ReplyDeleteOption Explicit
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 EmptyClipboard 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 GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) 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 GlobalFree Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpStr1 As Any, ByVal lpStr2 As Any) As LongPtr
Private Const CF_TEXT = 1&
Private Const GMEM_MOVEABLE = &H2
Sub CopyContent()
Call StringToClipboard(ActiveCell.Value)
End Sub
Private Sub StringToClipboard(strText As String)
Dim lngIdentifier As LongPtr, lngPointer As LongPtr
lngIdentifier = GlobalAlloc(GMEM_MOVEABLE, Len(strText) + 1)
lngPointer = GlobalLock(lngIdentifier)
Call lstrcpy(ByVal lngPointer, strText)
Call GlobalUnlock(lngIdentifier)
Call OpenClipboard(0&)
Call EmptyClipboard
Call SetClipboardData(CF_TEXT, lngIdentifier)
Call CloseClipboard
Call GlobalFree(lngIdentifier)
End Sub
Multiline and x64 version:
ReplyDeleteOption Explicit
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 EmptyClipboard 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 GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) 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 GlobalFree Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpStr1 As Any, ByVal lpStr2 As Any) As LongPtr
Private Const CF_TEXT = 1&
Private Const GMEM_MOVEABLE = &H2
Sub CopyContent()
'Call StringToClipboard(ActiveCell.Value)
Dim OneCell As Excel.Range
Dim RetVal As String
For Each OneCell In Selection
RetVal = RetVal & Chr$(13) & Chr$(10) & OneCell.Value
Next OneCell
Call StringToClipboard(RetVal)
End Sub
Private Sub StringToClipboard(strText As String)
Dim lngIdentifier As LongPtr, lngPointer As LongPtr
lngIdentifier = GlobalAlloc(GMEM_MOVEABLE, Len(strText) + 1)
lngPointer = GlobalLock(lngIdentifier)
Call lstrcpy(ByVal lngPointer, strText)
Call GlobalUnlock(lngIdentifier)
Call OpenClipboard(0&)
Call EmptyClipboard
Call SetClipboardData(CF_TEXT, lngIdentifier)
Call CloseClipboard
Call GlobalFree(lngIdentifier)
End Sub