Come impedire la copia e incolla su una cella con elenco a discesa in Excel?

Per una cella con un elenco a discesa di convalida dei dati, quando si copia il contenuto da un'altra cella e lo si incolla in essa, l'elenco a discesa scomparirà e verrà sostituito con il nuovo contenuto incollato. In alcuni casi, potresti voler impedire la copia e incolla di altri contenuti sulla cella con l'elenco a discesa; cosa faresti per gestire questa situazione? In questo articolo, otterrai un metodo VBA per affrontare questo problema.

Impedisci la copia e incolla su una cella con elenco a discesa in Excel

Impedisci la copia e incolla su una cella con elenco a discesa in Excel

1. Apri il foglio di lavoro con la cella dell'elenco a discesa su cui vuoi impedire la copia e incolla.

2. Premi contemporaneamente i tasti Alt + F11 per aprire la finestra Microsoft Visual Basic Applications.

3. Nella finestra Microsoft Visual Basic Applications, fai doppio clic sul nome del foglio di lavoro corrente nel riquadro sinistro, quindi copia e incolla il seguente codice VBA nell'editor del Codice. Vedi screenshot:

Codice VBA: Impedisci la copia e incolla su una cella con elenco a discesa

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20200903
    Dim xValue As String
    Dim xCheck1 As String
    Dim xCheck2 As String
    Dim xRg As Range
    Dim xArrCheck1() As String
    Dim xArrCheck2() As String
    Dim xArrValue()
    Dim xCount, xJ As Integer
    Dim xBol As Boolean
'    If Target.Count > 1 Then
'        Exit Sub
'        End If
    xCount = Target.Count
    ReDim xArrCheck1(1 To xCount)
    ReDim xArrCheck2(1 To xCount)
    ReDim xArrValue(1 To xCount)
    Application.EnableEvents = False
    On Error Resume Next
    xJ = 1
    For Each xRg In Target
        xArrValue(xJ) = xRg.Value
         xArrCheck1(xJ) = xRg.Validation.InCellDropdown
        xJ = xJ + 1
    Next

    Application.Undo

    xJ = 1
    For Each xRg In Target
        xArrCheck2(xJ) = xRg.Validation.InCellDropdown
        xJ = xJ + 1
    Next

    xBol = False
    For xJ = 1 To xCount
        If xArrCheck2(xJ) <> xArrCheck1(xJ) Then
            xBol = True
            Exit For
        End If
    Next

    If xBol Then
       MsgBox "The selected cells containg data validation drop-down lists, no pasting allowed."
    Else
        xJ = 1
        For Each xRg In Target
            xRg.Value = xArrValue(xJ)
            xJ = xJ + 1
        Next

    End If

    Application.EnableEvents = True
End Sub

4. Premi i tasti Alt + Q per uscire dalla finestra Microsoft Visual Basic Applications.

5. Quando incollerai il contenuto in una cella con elenco a discesa, apparirà una finestra di dialogo per avvisarti che l'incolla non è consentito. Vedi screenshot:

Nota: Questo VBA funziona solo per l'incolla in una singola cella. Se copi e incolli in più celle, non funzionerà.

Articoli correlati: