Dropdown Wert auslesen

Sub MakroUebersicht() Dim Zelle As Range Dim i As Long 'i = Zeile i = 4 For Each Zelle In Sheets("RG2 (Vergabe)").Range("G" & i, "G999") If Sheets("RG2 (Vergabe)").DrawingObjects("Dropdown 618").Text = "rot" or DrawingObjects(" _ Dropdown 618").Text = "gelb" Then 'wenn die Zelle die Farbe rot oder gelb trägt, Sheets("RG2 (Vergabe)").Range("A" & i - 1, "N" & i).Copy 'wird die jeweilige Zelle kopiert With Sheets("Übersicht") leereZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 leereZeile = WorksheetFunction.Max(5, leereZeile) .Cells(leereZeile, 1).PasteSpecial 'fügt die kopierte Zeile in die letzte leere Zeile des Tabellenblattes Übersicht ein End With Rows(i).Select Rows(i).EntireRow.AutoFit i = i + 1 End If Next End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub MakroUebersicht() Dim Zelle As Range Dim i As Long 'i = Zeile Dim leereZeile As Long Dim wert, wert2 i = 4 For Each Zelle In Sheets("RG2 (Vergabe)").Range("G" & i, "G999") With Sheets("RG2 (Vergabe)").Shapes("Dropdown 618").ControlFormat wert = .Value 'Indexwert des ausgewählten Listenwertes wert2 = .List(.Value) 'ausgewählter Listenwert End With If wert2 = "rot" Or wert2 = "gelb" Then 'wenn die Zelle die Farbe rot oder gelb trägt, Sheets("RG2 (Vergabe)").Range("A" & i - 1, "N" & i).Copy 'wird die jeweilige Zelle _ kopiert With Sheets("Übersicht") leereZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 leereZeile = WorksheetFunction.Max(5, leereZeile) .Cells(leereZeile, 1).PasteSpecial 'fügt die kopierte Zeile in die letzte leere Zeile des Tabellenblattes Übersicht ein End With Rows(i).Select Rows(i).EntireRow.AutoFit i = i + 1 End If Next End Sub

Hallo Franzi,
eine Möglichkeit, warum der Fehler noch auftreten kann: In dem DropDown wurde noch kein Eintrag gewählt.
Ich hab das Makro mit einer entsprechenden Prüfung und Meldung versehen.
Zusätzliche Anpassungen:
- letzte zu prüfende/kopierende Zeile wird variabel gesucht.
- Bildschirmaktualiiserung wird während der Makroausführung deaktiviert.
Gruß
Franz

Sub MakroUebersicht()
Dim Zelle As Range
Dim i As Long 'i = Zeile
Dim leereZeile As Long, oShape As Shape
Dim wert, wert2
i = 4
With Sheets("RG2 (Vergabe)")
Application.ScreenUpdating = False
For Each Zelle In .Range(.Cells(i, 7), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 6))
Set oShape = .Shapes("Dropdown 618")
With oShape.ControlFormat
wert = .Value 'Indexwert des ausgewählten Listenwertes
If .ListIndex = 0 Then
MsgBox "Kein Wert ausgewählt in """ & oShape.Name & """!"
GoTo Beenden
Else
wert2 = .List(.Value) 'ausgewählter Listenwert
End If
End With
If wert2 = "rot" Or wert2 = "gelb" Then
'wenn die Zelle die Farbe rot oder gelb trägt,
.Range("A" & i - 1, "N" & i).Copy 'wird die jeweilige Zelle kopiert
With Sheets("Übersicht")
leereZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
leereZeile = WorksheetFunction.Max(5, leereZeile)
.Cells(leereZeile, 1).PasteSpecial
'fügt die kopierte Zeile in die letzte leere Zeile des Tabellenblattes Übersicht  _
ein
End With
Rows(i).Select
Rows(i).EntireRow.AutoFit
i = i + 1
End If
Next
End With
Beenden:
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Dropdown Wert auslesen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread