Lista suspensa com múltipla seleção


#1

Criei uma plataforma para gerenciamento e monitoramento da vida escolar. Ela vem crescendo e se desenvolvendo muito com a demanda do trabalho.
No momento preciso de uma lista suspensa com múltipla seleção, para várias colunas na mesma planilha.
Encontrei um código em VBA que soluciona a questão para uma coluna apenas.
Alguém sabe como fazer para ativar a mesma função em várias colunas diferentes?
Segue o código abaixo:

Private Sub Worksheet_Change(ByVal Target As Range)
’ To Select Multiple Items from a Drop Down List in Excel
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 5 Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = “” Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = “” Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & ", " & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub


#2

Basta remover o If target.Column = 5 e um End if do final

  Private Sub Worksheet_Change(ByVal Target As Range)
    ’ To Select Multiple Items from a Drop Down List in Excel
    Dim Oldvalue As String
    Dim Newvalue As String
    Application.EnableEvents = True
    On Error GoTo Exitsub
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
    Else: If Target.Value = “” Then GoTo Exitsub Else
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
    If Oldvalue = “” Then
    Target.Value = Newvalue
    Else
    If InStr(1, Oldvalue, Newvalue) = 0 Then
    Target.Value = Oldvalue & ", " & Newvalue
    Else:
    Target.Value = Oldvalue
    End If
    End If
    End If
    Application.EnableEvents = True
    Exitsub:
    Application.EnableEvents = True
    End Sub