[VBA Excel] Chỉ cho phép paste value trong bảng tính

2 đoạn code VBA dưới đây chỉ cho phép paste giá trị (paste value only) mà không giữ các format.

Code1: Sử dụng cho toàn bộ bảng tính (Workbook)

Option Explicit
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim UndoList As String
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
 
    On Error GoTo Whoa
 
    '~~> Get the undo List to capture the last action performed by user
    UndoList = Application.CommandBars("Standard").Controls("&Undo").List(1)
 
    '~~> Check if the last action was not a paste nor an autofill
    If Left(UndoList, 5) <> "Paste" And UndoList <> "Auto Fill" _
    Then GoTo LetsContinue
 
    '~~> 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 = "Auto Fill" Then Selection.Copy
 
    '~~> Do a pastespecial to preserve formats
    On Error Resume Next
    '~~> Handle text data copied from a website
    Target.Select
    ActiveSheet.PasteSpecial Format:="Text", _
    Link:=False, DisplayAsIcon:=False
 
    Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    On Error GoTo 0
 
    '~~> Retain selection of the pasted data
    Union(Target, Selection).Select
 
LetsContinue:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.description
    Resume LetsContinue
End Sub

Code2: Sử dụng cho 1 bảng tính (Worksheet)

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim UndoList As String
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
 
    On Error GoTo Whoa
 
    '~~> Get the undo List to capture the last action performed by user
    UndoList = Application.CommandBars("Standard").Controls("&Undo").List(1)
 
    '~~> Check if the last action was not a paste nor an autofill
    If Left(UndoList, 5) <> "Paste" And UndoList <> "Auto Fill" _
    Then GoTo LetsContinue
 
    '~~> 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 = "Auto Fill" Then Selection.Copy
 
    '~~> Do a pastespecial to preserve formats
    On Error Resume Next
    '~~> Handle text data copied from a website
    Target.Select
    ActiveSheet.PasteSpecial Format:="Text", Link:=False, _
    DisplayAsIcon:=False
 
    Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    On Error GoTo 0
 
    '~~> Retain selection of the pasted data
    Union(Target, Selection).Select
 
LetsContinue:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.description
    Resume LetsContinue
End Sub

Sưu tầm từ siddharthrout.com