This method is by windows API. Paste as link method is very slow when you will copy a full column. This code works in 64bit. Didnot check in 32bit.
Oddclock posted this amazing code.
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongLong) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function RegisterClipboardFormat Lib "user32.dll" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
'reads excel copy-paste range from the clipboard and returns range object or nothing if not found
'_2022_03_19
Function fGetClipboardRange() As Range 'get excel copy or cut range from clipboard
Dim strClipboard As String 'raw clipboard data
Dim arrClipboard() As String 'parse into an array
Set fGetClipboardRange = Nothing 'default is nothing
strClipboard = fGetClipboardData("link") 'get the link data string
If strClipboard = "" Then Exit Function 'done if it's empty
arrClipboard = Split(strClipboard, Chr(0)) 'else parse at null characters
If arrClipboard(0) <> "Excel" Then Exit Function 'excel should be first
strClipboard = "'" & arrClipboard(1) & "'!" & arrClipboard(2) 'parse the range from the others
strClipboard = Application.ConvertFormula(strClipboard, xlR1C1, xlA1) 'convert to a1 style
Set fGetClipboardRange = Range(strClipboard) 'range needs a1 style
End Function
'read clipboard for specified format into string or null string
'_2022_03_19
Function fGetClipboardData(strFormatId As String) As String 'read clipboard into string
Dim arrData() As Byte 'clipboard reads into this array
Dim hMem As LongPtr 'memory handle
Dim lngPointer As LongPtr 'memory pointer
Dim lngSize As Long 'size on clipboard
Dim lngFormatId As Long 'id number, for format name
fGetClipboardData = "" 'default
lngFormatId = fGetClipboardFormat(strFormatId) 'get format
If lngFormatId <= 0 Then Exit Function 'zero if format not found
CloseClipboard 'in case clipboard is open
If CBool(OpenClipboard(0)) Then 'open clipboard
hMem = GetClipboardData(lngFormatId) 'get memory handle
If hMem > 0 Then 'if there's a handle
lngSize = CLng(GlobalSize(hMem)) 'get memory size
If lngSize > 0 Then 'if we know the size
lngPointer = GlobalLock(hMem) 'get memory pointer
If lngPointer > 0 Then 'make sure we have the pointer
ReDim arrData(0 To lngSize - 1) 'size array
CopyMemory arrData(0), ByVal lngPointer, lngSize 'data from pointer to array
fGetClipboardData = StrConv(arrData, vbUnicode) 'convert array to string
End If
GlobalUnlock hMem 'unlock memory
End If
End If
End If
CloseClipboard 'don't leave the clipboard open
End Function
'return verified format number for format number, format number from format name or 0 for not found
'_2022_03_19
Function fGetClipboardFormat(strFormatId As String) As Long 'verify, or get format number from format name
Dim lngFormatId As Long 'format id number
fGetClipboardFormat = 0 'default false
If IsNumeric(strFormatId) Then 'for format number
lngFormatId = CLng(strFormatId) 'use number for built in format
CloseClipboard 'in case clipboard is already open
If CBool(OpenClipboard(0)) = False Then 'done if can't open clipboard
ElseIf CBool(IsClipboardFormatAvailable(lngFormatId)) = True Then 'true if format number found
fGetClipboardFormat = lngFormatId 'return format number
End If
CloseClipboard 'don't leave the clipboard open
Else
lngFormatId = RegisterClipboardFormat(strFormatId & Chr(0)) 'else get number from format name
If (lngFormatId > &HC000) Then fGetClipboardFormat = lngFormatId 'if valid return format number
End If
End Function
Sub test()
If Application.CutCopyMode Then CopyRefEditTB.Value = fGetClipboardRange.Address
End Sub
