Disable Copy and Paste in a Worksheet

[wlbamc]

I have a worksheet with a number of columns with dropdown boxes. Is there a way I can stop people copying and pasting other information into these cells so restricting them to just picking from the dropdown lists. I am happy to stop all copying and pasting into this worksheet as long as my dropdowns and VBA code for moving information from this sheet still works. Many thanks

 

[Candyman8019]

In your data validation go to the error alert tab and make sure the show error box is checked off. This will allow only items in your list to be selected.

 

[wlbamc]

In your data validation go to the error alert tab and make sure the show error box is checked off. This will allow only items in your list to be selected.

Hi, I have checked this and it is ticked, which stops them typing something else but they can still copy and paste over the cells

 

[wlbamc]

I have now found the VBA to stop copy and pasting

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xValue As String
    Dim xCheck1 As String
    Dim xCheck2 As String
    If Target.Count > 1 Then
        Exit Sub
        End If
        Application.EnableEvents = False
        xValue = Target.Value
        On Error Resume Next
        xCheck1 = Target.Validation.InCellDropdown
        On Error GoTo 0
        Application.Undo
        On Error Resume Next
        xCheck2 = Target.Validation.InCellDropdown
        On Error GoTo 0
        If xCheck1 = xCheck2 Then
            Target = xValue
        Else
            MsgBox "No pasting allowed!"
        End If
        Application.EnableEvents = True
    End Sub

Can I now incorporate another Worksheet_Change to this one

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    If Intersect(Target, Range("M:M")) Is Nothing Then Exit Sub
    On Error GoTo endit
    Application.EnableEvents = False
    If Target.Value = "Band 7's" Then
        Target.EntireRow.Copy Worksheets("Band 7's").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        Target.EntireRow.Delete
    ElseIf Target.Value = "Panel Letters" Then
        Target.EntireRow.Copy Worksheets("Panel Letters").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        Target.EntireRow.Delete
    ElseIf Target.Value = "Letters to be signed" Then
        Target.EntireRow.Copy Worksheets("Letters to be signed").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        Target.EntireRow.Delete

End If
endit:
     Application.EnableEvents = True
     Application.ScreenUpdating = True
End Sub

I believe this can be done but have never done it. Many thanks