How to Avoid Extra Double Quotes When Copying From Excel

excel copy content without double quote

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
1. Open the excel work you want to copy content from

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

visual basic for application adding VB script image

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
saving visual basic macros in excel

6. Now got View > Macros > View Macros
View macros menu in excel

7. Select the saved Macros and click Options
Add a shortcut key for the Macro (for example, add Ctrl + q). Then close Macro

Adding short cut key to the visual basic macros  excel

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

Post a Comment

5 Comments

  1. I need this in multiple cells not just one cell. Please help.

    ReplyDelete
  2. For 64 bit version, try this:
    Option 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

    ReplyDelete
  3. Multiline and x64 version:
    Option 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

    ReplyDelete