Block Cut and Drag BUT Allow Paste From Other Worksheet

BruceJ

New Member
Joined
Jul 27, 2017
Messages
9
Hi All,

I have VBA code modified from Ken Puls post here VBA Express : Excel - Disable Cut, Copy, Paste, that blocks users from Drag/Drop and Cutting (all except the Cut on the Ribbon) but an unintended consequence is that it affects the clipboard so users are not able to paste data from other worksheets. I'm hoping that the code can be modified to either allow pasting into unlocked cells or allow it for a range on a specific tab of the workbook.

A little background....the worksheet is used by a number of staff with varying skill levels to calculate budgets. The worksheet has hidden sheets, rows, columns and all cells are locked except those that are for user input. Some users will unintentionally drag one unlocked cell to another unlocked cell and break a formula. One tab, named "Forecast" has a large unlocked range for users to paste a finance report into. Values from the Forecast are used in other parts of the workbook.

The current code is:

In a Module

Option Explicit

Sub ToggleCutCopyAndPaste(Allow As Boolean)
'Activate/deactivate cut, copy, paste and pastespecial menu items
Call EnableMenuItem(21, Allow) ' cut

'Activate/deactivate drag and drop ability
Application.CellDragAndDrop = Allow

'Activate/deactivate cut, copy, paste and pastespecial shortcut keys
With Application
Select Case Allow
Case Is = False
.OnKey "^x", "CutCopyPasteDisabled"
Case Is = True
.OnKey "^x"
End Select
End With
End Sub

Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean)
'Activate/Deactivate specific menu item
Dim cBar As CommandBar
Dim cBarCtrl As CommandBarControl
For Each cBar In Application.CommandBars
If cBar.Name <> "Clipboard" Then
Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled
End If
Next
End Sub

Sub CutCopyPasteDisabled()
'Inform user that the functions have been disabled
MsgBox "Sorry! Cutting, Drag and Drop have been disabled in this workbook!"
End Sub


And in This Workbook

Option Explicit

Private Sub Workbook_Activate()
Call ToggleCutCopyAndPaste(False)
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call ToggleCutCopyAndPaste(True)
End Sub

Private Sub Workbook_Deactivate()
Call ToggleCutCopyAndPaste(True)
End Sub

Private Sub Workbook_Open(),
Call ToggleCutCopyAndPaste(False)
End Sub

Thanks for any help.

Bruce
 
Last edited:

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

Forum statistics

Threads
1,214,647
Messages
6,120,722
Members
448,987
Latest member
marion_davis

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top