Option Explicit
'-----------------
'Paste Values only
'-----------------
'Call from ThisWorkbook:
'Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' Call PasteValuesOnly(Target)
'End Sub
'
'Call from a Worksheet:
'Private Sub Worksheet_Change(ByVal Target As Range)
' Call PasteValuesOnly(Target)
'End Sub
'
'Sur la base de:
'https://stackoverflow.com/questions/24391518/vba-refer-to-excel-undolist-language-independent
'-----------------
Sub PasteValuesOnly(ByVal Target As Range, _
Optional ByVal CheckPaste As Boolean = True, _
Optional ByVal CheckPasteSpecial As Boolean = True, _
Optional ByVal CheckAutoFill As Boolean = True)
'Constants subject to local language adaptation
Const PasteSpecialLetterForValueOptionLocalName = "v"
Const UndoPasteLocalName = "Coller"
Const UndoPasteSpecialLocalName = "Collage spécial"
Const UndoAutoFillLocalName = "Recopie Incrémentée"
Const FormatTextLocalName = "Texte"
'Misc Constants
Const DisplayUndoList = False
Const PasteSpecialMenuShortcut = "^%v"
'Misc variables
Dim UndoList As String
'~~> Get the Undo List to capture the last action performed by user
On Error Resume Next
UndoList = Application.CommandBars("Standard").FindControl(ID:=128).List(1)
On Error GoTo 0
If DisplayUndoList Then MsgBox Target.Address & " -> <" & UndoList & ">"
'~~> Check if the last action was a Paste, a PasteSpecail or an Autofill
If (CheckPaste And UndoList = UndoPasteLocalName) _
Or (CheckPasteSpecial And UndoList = UndoPasteSpecialLocalName) _
Or (CheckAutoFill And UndoList = UndoAutoFillLocalName) Then
Application.ScreenUpdating = False
Application.EnableEvents = False
'~~> Undo the paste that the user did but we are not clearing
'~~> the clipboard so the copied data is still in memory
Application.Undo
If UndoList = UndoAutoFillLocalName Then Selection.Copy
'~~> Do a Paste special to preserve formats
Target.Select
On Error Resume Next
'~~> Handle text data copied from a website (in error if Excel content)
ActiveSheet.PasteSpecial Format:=FormatTextLocalName, _
Link:=False, DisplayAsIcon:=False
'~~> Handle Excel content copied from Excel (in error if text data)
Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
On Error GoTo 0
'~~> Retain selection of the pasted data
Union(Target, Selection).Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End Sub
etc...
)
