Dropdown ohne Mehrfachauswahl

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows. _ Count) If blnAusfuehren = False Then If Not Intersect(Target, Columns(2).SpecialCells(xlCellTypeAllValidation)) Is Nothing _ Then If Target.Value "" And Target.Value "keine Auswahl" Then Set rng = FindeWert(ActiveSheet, "B21:B" & lngLetzte, Target.Value) If Not rng Is Nothing Then If rng.Row = Target.Row Then DiaAktualisieren Else MsgBox "Bereits ausgewählt" Target.Value = "" End If Else DiaAktualisieren End If End If End If End If End Sub

Hallo
das letzte Blatt kann entfallen...
- Rechtsclick auf den Tabellenblattreiter
- Code anzeigen
- Diesen Code dort reinkopieren

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim RNG As Range, WS, Z, strFilter As String
    Set RNG = Range("B22:B360")
    
    On Error GoTo Fehler
    If Not Intersect(RNG, Target) Is Nothing Then
        For Each Z In Target
            strFilter = ""
            For Each WS In ActiveWorkbook.Sheets
                If WS.Name <> ActiveSheet.Name Then
                    If Application.WorksheetFunction.CountIf(RNG, WS.Name) = 0 Then
                        strFilter = strFilter & WS.Name & ","
                    End If
                End If
            Next
            If strFilter <> "" Then
                With RNG.Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                        xlBetween, Formula1:=strFilter
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .ShowInput = True
                    .ShowError = True
                End With
            Else 'alles schon belegt 
                With Target.Validation
                    .Delete
                End With
                MsgBox "Alle Blätter bereits eingeteilt"
    
            End If
        Next Z
    End If
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear

End Sub

LG UweD

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Dropdown ohne Mehrfachauswahl

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread