如何用VBA禁用Excel剪切、复制功能但允许从外部Excel粘贴？

步骤1：替换ThisWorkbook模块代码 #

把你原有的代码替换为以下内容：

Private Sub Workbook_Activate()
    ' 禁用当前工作簿的复制快捷键与单元格拖放
    Application.OnKey "^c", "DisableCopy"
    Application.CellDragAndDrop = False
    ' 绑定自定义粘贴检查逻辑到Ctrl+V
    Application.OnKey "^v", "CheckPaste"
End Sub

Private Sub Workbook_Deactivate()
    ' 恢复Excel默认的复制、粘贴与拖放功能
    Application.CellDragAndDrop = True
    Application.OnKey "^c"
    Application.OnKey "^v"
End Sub

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
    Application.OnKey "^c", "DisableCopy"
    Application.CellDragAndDrop = False
    Application.OnKey "^v", "CheckPaste"
End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
    Application.CellDragAndDrop = True
    Application.OnKey "^c"
    Application.OnKey "^v"
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    ' 仅清除当前工作簿的复制状态
    If ActiveWorkbook Is ThisWorkbook Then
        Application.CutCopyMode = False
    End If
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Application.OnKey "^c", "DisableCopy"
    Application.CellDragAndDrop = False
    Application.OnKey "^v", "CheckPaste"
End Sub

步骤2：添加标准模块与检查逻辑 #

1. 按下Alt+F11打开VBE编辑器
2. 右键点击当前工作簿，选择「插入」→「模块」
3. 在新模块中粘贴以下代码：

Sub DisableCopy()
    ' 提示用户无法从当前工作簿复制内容
    MsgBox "无法从当前工作簿复制内容", vbExclamation
    Application.CutCopyMode = False
End Sub

Sub CheckPaste()
    Dim dataObj As Object
    Set dataObj = CreateObject("MSForms.DataObject")
    dataObj.GetFromClipboard
    
    ' 判断剪贴板内容来源
    If Not Application.CutCopyMode = False Then
        ' 若复制内容来自其他Excel工作簿，允许粘贴
        If Not Application.CutCopyMode.Source.Workbook Is ThisWorkbook Then
            ActiveSheet.Paste
        Else
            MsgBox "禁止粘贴当前工作簿内的内容", vbExclamation
        End If
    Else
        ' 处理纯文本等非单元格内容（可根据需求调整是否允许）
        On Error Resume Next
        ActiveSheet.Paste
        On Error GoTo 0
        If Err.Number <> 0 Then
            MsgBox "仅允许粘贴来自外部Excel的内容", vbExclamation
        End If
    End If
End Sub

额外需求：限制仅从外部特定区域粘贴 #

如果需要仅允许从外部Excel的C3:E10区域粘贴，可修改CheckPaste中的判断行，添加区域校验：

' 修改后的判断逻辑
If Not Application.CutCopyMode.Source.Workbook Is ThisWorkbook And Application.CutCopyMode.Source.Address = "$C$3:$E$10" Then

内容的提问来源于stack exchange，提问作者Mamed Aliyev