[useful code]

[wOxxOm]

Here go the two handy functions to read and write the text contents of clipboard in unicode directly into/from VBA variables.

Reading of clipboard into a string variable
myStr = ClipboardGetUnicode()

Writing a string variable to the clipboard
bSucceed = ClipboardSetUnicode( myStr ) 'in case you need a status of the operation
ClipboardSetUnicode myStr 'just put it there

you can put the code text into a new module and name it mClipboard for convenience

Option Explicit

Private Declare Function OpenClipboard& Lib "user32" (ByVal hWnd&)
Private Declare Function SetClipboardData& Lib "user32" (ByVal Format&, ByVal hMem&)
Private Declare Function GetClipboardData& Lib "user32" (ByVal Format&)
Private Declare Function CloseClipboard& Lib "user32" ()
Private Declare Function EmptyClipboard& Lib "user32" ()
Private Declare Function GlobalAlloc& Lib "kernel32" (ByVal Flags&, ByVal amount&)
Private Declare Function GlobalLock& Lib "kernel32" (ByVal hMem&)
Private Declare Function GlobalUnlock& Lib "kernel32" (ByVal hMem&)
Private Declare Function lstrlenW& Lib "kernel32" (ByVal lpStrW&)
private Declare Sub memmove Lib "ntdll" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef source As Any, ByVal Length&)

Private Const CF_UNICODETEXT = 13, GMEM_MOVEABLE = 2, GMEM_ZEROINIT = 32

Public Function ClipboardSetUnicode(text$) As Boolean
   Dim hMem&, pMem&, L&
   On Error Resume Next
   L = LenB(text): If L = 0 Then Exit Function
   If OpenClipboard(AppWindow.Handle) Then
      If EmptyClipboard Then
         hMem = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, L + 2)
         If hMem Then
            pMem = GlobalLock(hMem)
            If pMem Then
               memmove ByVal pMem, ByVal StrPtr(text), L + 2
               GlobalUnlock hMem
               SetClipboardData CF_UNICODETEXT, hMem
               ClipboardSetUnicode = True
            End If
         End If
      End If
      CloseClipboard
   End If
End Function

Public Function ClipboardGetUnicode() As String
   Dim hMem&, tLen&
   On Error Resume Next
   If OpenClipboard(AppWindow.Handle) Then
      hMem = GetClipboardData(CF_UNICODETEXT)
      If hMem Then
         tLen = lstrlenW(hMem)
         If tLen Then
            ClipboardGetUnicode = Space$(tLen)
            memmove ByVal StrPtr(ClipboardGetUnicode), ByVal hMem, tLen * 2
         End If
      End If
      CloseClipboard
   End If
End Function