01.12.2021, 10:13
Hallo, ich habe folgendes Problem. Ich benötige ein Multi Drop Down Menü für eine Tabelle. Das Habe ich soweit auch im Internet gefunden und getest. Es Funktioniert auch alles soweit ich müsste nun aber in dem Code als Bezugstabelle eine andere Arbeitsmappe angeben, könnte mir jemand erklären was ich ändern muss bzw. wie?
Ich habe Fett markiert wie es aktuell aussieht, ich müsste aber die Daten aus der Tabelle von Arbeitsmappe 2 entnehmen und auf Arbeitsmappe 1 Ausgeben.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Not Intersect(Target, Range("A2:C12")) Is Nothing 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
Ich habe Fett markiert wie es aktuell aussieht, ich müsste aber die Daten aus der Tabelle von Arbeitsmappe 2 entnehmen und auf Arbeitsmappe 1 Ausgeben.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Not Intersect(Target, Range("A2:C12")) Is Nothing 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