DropDown untereinander erstellen

Frage: In einem Tabellenblatt sollen rechts von der gerade aktiven Zelle 3 DropDown (aus Formular) untereinander erstellt werden. Der Datenbereich (ListFillRange) liegt in einem anderen Tabellenblatt. Die "LinkedCell" soll Spalte G mit der entsprechenden Zeile sein. Wie geht das?

Option Explicit
Public Sub Main()
    Dim strRange As String
    Dim objDrop As Object
    Dim lngTMP As Long
    Dim lngRow As Long
    Dim bytTMP As Byte
    On Error GoTo Fin
    For bytTMP = 0 To 2
        With ThisWorkbook.Worksheets("Sheet1") ' adapt!!!
            strRange = ActiveCell.Offset(bytTMP, 1).Address
            lngTMP = ActiveCell.Row
            Set objDrop = .DropDowns.Add _
                (.Range(strRange).Left, _
                .Range(strRange).Top, _
                .Range(strRange).Width, _
                .Range(strRange).Height)
            With objDrop
                .ListFillRange = "Sheet2!$B$5:$B$15"
                .LinkedCell = "G" & lngTMP + bytTMP
                .DropDownLines = 8
                .Display3DShading = False
            End With
            Set objDrop = Nothing
        End With
    Next bytTMP
Fin:
    Set objDrop = Nothing
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub

Hier noch eine Beispieldatei: Sample

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...