Dropdown-Feld nutzen um mehrere Zellen zu füllen

Problem:

Ich möchte in Tabelle1 ein Auswahlfeld erstellen, das mehrere Werte zur Auswahl aus Tabelle2 anbietet.

1. Lösung: Liste des Drop-Down-Feldes kommt aus anderen Tabellenblatt

In Excel 2007 bzw. Excel 2010 gehen Sie wie folgt vor:

2. Lösung: Liste des Drop-Down-Feldes wird direkt hinterlegt

In Excel 2007 bzw. Excel 2010 gehen Sie wie folgt vor:

3. Lösung: VBA-Lösung die ein Drop-Down-Feld (Kombinationsfeld) nutzt, um mehrere Zellen zu füllen

Eine Lösung findet sich in folgendem Artikel:
https://www.ms-office-forum.net/forum/showthread.php?t=300957

Bereiten Sie eine Excel-Datei wie folgt vor:

Füllen Sie im Tabellenblatt „Tabelle1“ die Zellen A3 bis A22 mit einer Liste von Obstsorten (Apfel, Banane, Kiwi, etc.)

Legen Sie folgenden Quellcode für das Tabellenblatt „Tabelle1“ an: 

Option Explicit                             ' Variablendeklaration erforderlich

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    '**************************************************
    '* 24.12.10                                       *
    '* erstellt von Karin (Beverly), http://Excel-Inn.de*
    '* Beverly_Forums@web.de                          *
    '**************************************************
    Dim oobElement As OLEObject             ' Variable für das Steuerelement als OLEObject
    On Error Resume Next
    ActiveSheet.OLEObjects("DropDownZoom").Delete
    On Error GoTo 0
    If Not Intersect(Target, Range("C5:C35")) Is Nothing Then
        ' Bildschirmaktualisierung aus
        Application.ScreenUpdating = False
        ' ComboBox erstellen
        Set oobElement = OLEObjects.Add(ClassType:="Forms.ComboBox.1", Left:=0, Top:=0, Width:=0, Height:=0)
        With oobElement
            .Top = ActiveCell.Top          ' Position oben
            .Left = ActiveCell.Left        ' Position links
            .Width = Range(ActiveCell, ActiveCell.Offset(0, 1)).Width ' Breite
            .Height = Range(ActiveCell, ActiveCell.Offset(1, 0)).Height ' Höhe
            .ListFillRange = "Liste"        ' Quellbereich, per Name "Liste" definiert
            .Name = "DropDownZoom"          ' Name zuweisen
            .Object.MatchRequired = True    ' nur vorhandene Einträge
            .Object.ListRows = 14           ' Zeilenanzahl der Liste
            .Object.Font.Size = 12          ' Schriftgröße
            .Object.DropDown                ' DropDown öffnen
            .Object.ListIndex = 0           ' 1. Eintrag auswählen
            ' Umwandeln in ein Datum - nur erforderlich wenn die Auswahl aus Datumswerten besteht
            If IsDate(Range(.ListFillRange).Cells(1)) Then .Object = CStr(CDate(.Object))
            .Activate                       ' aktivieren
            ' erforderlich, da andernfalls der 1. Eintrag nicht in die Zelle eingetragen werden kann,
            ' weil seine Auswahl kein Change-Ereignis auslöst da er bereits ausgwählt ist
            ' mit dem Makro "Eintrag" wird der 1. Eintrag in die Zelle geschrieben
            Application.OnTime Now + TimeValue("00:00:00"), "Eintrag"
        End With
        ' Bildschirmaktualisierung ein
        Application.ScreenUpdating = True
    End If
End Sub

Private Sub DropDownZoom_Change()
    '**************************************************
    '* 24.12.10                                       *
    '* erstellt von Karin (Beverly), http://Excel-Inn.de*
    '* Beverly_Forums@web.de                          *
    '**************************************************
    ' Wert aus der Liste wurde gewählt
    If DropDownZoom.MatchFound Then
        ' Umwandeln in ein Datum
        If IsDate(Range(DropDownZoom.ListFillRange).Cells(1)) Then _
            DropDownZoom = CStr(CDate(DropDownZoom))
    ' Wert nicht in Liste vorhanden
    Else
        ' leeren
        DropDownZoom = ""
    End If
    ' Wert aus der betreffenden Zelle des Quellbereichs in aktuelle Zelle eintragen
    ' ListIndex beginnt bei 0, deshalb + 1
    Range(DropDownZoom.TopLeftCell.Address) = _
        Range(DropDownZoom.ListFillRange).Cells(DropDownZoom.ListIndex + 1)
    ' aktuelle Zelle wie Ausgangszelle formatieren
    Range(DropDownZoom.TopLeftCell.Address).NumberFormat = _
        Range(DropDownZoom.ListFillRange).Cells(DropDownZoom.ListIndex + 1).NumberFormat
End Sub



' Makro nur zu Programmierzwecken erforderlich falls die Reaktion auf die Eingabe
' nicht mehr erfolgt
Sub bbbb()
Application.EnableEvents = True
End Sub

Legen Sie ein Modul mit dem Bezeichnung „mdlAllgemein“ mit folgendem Quellcode an: 

Option Explicit
Option Private Module

Sub Eintrag()
    '**************************************************
    '* 24.12.10                                       *
    '* erstellt von Karin (Beverly), http://Excel-Inn.de*
    '* Beverly_Forums@web.de                          *
    '**************************************************
    If Not Intersect(Range(ActiveSheet.DropDownZoom.TopLeftCell.Address), Range("C5:C35")) Is Nothing Then
        ' Eintrag des 1. Wertes (ListIndex = 0) der ComboBox
        Range(ActiveSheet.DropDownZoom.TopLeftCell.Address) = _
            Range(ActiveSheet.DropDownZoom.ListFillRange).Cells(1)
        Range(ActiveSheet.DropDownZoom.TopLeftCell.Address).NumberFormat = _
            Range(ActiveSheet.DropDownZoom.ListFillRange).Cells(1).NumberFormat
    End If
End Sub

Weiterführende Hinweise: