Einfache Sache, ich sehs nicht

Hallo miteinander,
ich hänge fest und finde die Lösung nicht.
Bei Eintrag in die Zelle mit Namen "AnzahlFahrzeuge" (= H4 bzw. R4C8)soll das Makro ausgelöst werden, sofern Zelle "MENR" Offset(-2,0) nicht leer ist, sonst Msg Box und Ende.
Hier mein "Werk" :) kann mir bitte jemand auf die Sprünge helfen?


Private Sub Worksheet_Change(ByVal Target As Range)
Dim AnzahlFahrzeuge As Byte
If Target.Cells <> "AnzahlFahrzeuge" Then Exit Sub
If Target.Offset(-2, 0) <> "" Then
With Target.Offset(0, 0)
Select Case AnzahlFahrzeuge
Case 1
Sheets("Fahrzeug (2)").Activate
ActiveWorkbook.Sheets("Fahrzeug (2)").Tab.ColorIndex = -4142
Sheets("Fahrzeug (2)").Activate
ActiveWorkbook.Sheets("Fahrzeug (3)").Tab.ColorIndex = -4142
Sheets("Fahrzeug (2)").Activate
ActiveWorkbook.Sheets("Fahrzeug (4)").Tab.ColorIndex = -4142
Sheets("Fahrzeug (2)").Activate
ActiveWorkbook.Sheets("Fahrzeug (5)").Tab.ColorIndex = -4142
Sheets("Zeitmeldung").Move after:=Sheets("Fahrzeug")
Case 2
Sheets("Fahrzeug (2)").Activate
Sheets("Fahrzeug (2)").Tab.ColorIndex = 50
Sheets("Zeitmeldung").Move Before:=Sheets("Fahrzeug (3)")
Case 3
Sheets("Fahrzeug (2)").Activate
ActiveWorkbook.Sheets("Fahrzeug (2)").Tab.ColorIndex = 50
Sheets("Fahrzeug (2)").Activate
ActiveWorkbook.Sheets("Fahrzeug (3)").Tab.ColorIndex = 50
Sheets("Zeitmeldung").Move Before:=Sheets("Fahrzeug (4)")
Case 4
Sheets("Fahrzeug (2)").Activate
ActiveWorkbook.Sheets("Fahrzeug (2)").Tab.ColorIndex = 50
Sheets("Fahrzeug (2)").Activate
ActiveWorkbook.Sheets("Fahrzeug (3)").Tab.ColorIndex = 50
Sheets("Fahrzeug (2)").Activate
ActiveWorkbook.Sheets("Fahrzeug (4)").Tab.ColorIndex = 50
Sheets("Zeitmeldung").Move Before:=Sheets("Fahrzeug (5)")
Case 5, Is > 5
Sheets("Fahrzeug (2)").Activate
ActiveWorkbook.Sheets("Fahrzeug (2)").Tab.ColorIndex = 50
Sheets("Fahrzeug (2)").Activate
ActiveWorkbook.Sheets("Fahrzeug (3)").Tab.ColorIndex = 50
Sheets("Fahrzeug (2)").Activate
ActiveWorkbook.Sheets("Fahrzeug (4)").Tab.ColorIndex = 50
Sheets("Fahrzeug (2)").Activate
ActiveWorkbook.Sheets("Fahrzeug (5)").Tab.ColorIndex = 50
Sheets("Zeitmeldung").Move after:=Sheets("Fahrzeug (5)")
Else: GoTo Fehler
End Select
End With
End If
Sheets("Antrag_Entsendung").Select
Range("b7").Select
Fehler:
MsgBox ("Bitte ME-NR. eintragen")
Exit Sub
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Winfried,
dann würde ich das so machen:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("AnzahlFahrzeuge")) Is Nothing Or _
        Not Intersect(Target, Range("MENR")) Is Nothing Then
        If Trim$(Range("AnzahlFahrzeuge").Text) <> "" And _
            Trim$(Range("MENR").Text) <> "" Then
            Select Case Range("AnzahlFahrzeuge").Value
                Case 1
                    Sheets(Array("Fahrzeug (2)", "Fahrzeug (3)", "Fahrzeug (4)", _
                        "Fahrzeug (5)")).Tab.ColorIndex = -4142
                    Sheets("Zeitmeldung").Move After:=Sheets("Fahrzeug")
                Case 2
                    Sheets("Fahrzeug (2)").Tab.ColorIndex = 50
                    Sheets("Zeitmeldung").Move Before:=Sheets("Fahrzeug (3)")
                Case 3
                    Sheets(Array("Fahrzeug (2)", "Fahrzeug (3)")).Tab.ColorIndex = 50
                    Sheets("Zeitmeldung").Move Before:=Sheets("Fahrzeug (4)")
                Case 4
                    Sheets(Array("Fahrzeug (2)", "Fahrzeug (3)", "Fahrzeug (4)")). _
                        Tab.ColorIndex = 50
                    Sheets("Zeitmeldung").Move Before:=Sheets("Fahrzeug (5)")
                Case Is >= 5
                    Sheets(Array("Fahrzeug (2)", "Fahrzeug (3)", "Fahrzeug (4)", _
                        "Fahrzeug (5)")).Tab.ColorIndex = 50
                    Sheets("Zeitmeldung").Move After:=Sheets("Fahrzeug (5)")
                Case Else
                    MsgBox "Anzahl der Fahrzeuge falsch"
                    Exit Sub
            End Select
            Sheets("Antrag_Entsendung").Select
            Range("B7").Select
        ElseIf Trim$(Range("AnzahlFahrzeuge")) <> "" Then
            MsgBox "Bitte ME-NR. eintragen"
            Range("MENR").Select
        End If
    End If
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread