Effektiv Code-Zeilen sparen

Hallo,
möchte mal gern wissen, wie ich nachfolgenden Code so umschreiben kann, dass ich den nicht 50 mal für jede neue Zeile kopieren muss. Sicherlich denkt jetzt einer, warum so ein langer Code, wenn man dass doch ganz einfach über "Extras" -> "Schutz" - >"Blatt schützen..." -> "das Häcken bei 'gesperrte Zellen auswählen' rausnimmt" lösen könnte. Ja das weiß ich, möchte ich aber nicht. ;-)
Mir geht es wirklich nur darum diesen funktionsfähigen Code so schreiben, dass er für 50 weitere Zeilen funktioniert ohne den code so oft kopieren zu müssen.
Mit freundlichen Grüßen
Richard


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E10")) Is Nothing Then
Range("G10").Select
End If
If Not Intersect(Target, Range("G10")) Is Nothing Then
Range("M10").Select
End If
If Not Intersect(Target, Range("M10")) Is Nothing Then
Range("O10").Select
End If
If Not Intersect(Target, Range("O10")) Is Nothing Then
Range("Q10").Select
End If
If Not Intersect(Target, Range("Q10")) Is Nothing Then
Range("S10").Select
End If
If Not Intersect(Target, Range("S10")) Is Nothing Then
Range("U10").Select
End If
If Not Intersect(Target, Range("U10")) Is Nothing Then
If Range("W10").Value = "JA" Then
Range("C10,E10,G10,I10,K10,M10,O10,Q10,S10,U10,W10").Select
Selection.Interior.ColorIndex = 35
Selection.Font.ColorIndex = 10
Range("E11").Select
Else
Range("C10,E10,G10,I10,K10,M10,O10,Q10,S10,U10,W10").Select
Selection.Interior.ColorIndex = 38
Selection.Font.ColorIndex = 53
Range("E11").Select
End If
End If
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row >= 10 Then If Target.Columns.Count = 1 Then Select Case Target.Column Case 5, 7, 9, 11, 13, 15, 17, 19 Target.Offset(0, 2).Select Case 21 If Target.Offset(0, 2).Value = "JA" Then With Range("C1,E1,G1,I1,K1,M1,O1,Q1,S1,U1,W1") .Offset(Target.Row - 1).Interior.ColorIndex = 35 .Offset(Target.Row - 1).Font.ColorIndex = 10 End With Else With Range("C1,E1,G1,I1,K1,M1,O1,Q1,S1,U1,W1") .Offset(Target.Row - 1).Interior.ColorIndex = 38 .Offset(Target.Row - 1).Font.ColorIndex = 53 End With End If Cells(Target.Row + 1, 5).Select Case Else End Select End If End If End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row >= 10 Then
    If Target.Columns.Count = 1 Then
        Select Case Target.Column
            Case 7
                Target.Offset(0, 6).Select
            Case 5, 7, 9, 11, 13, 15, 17, 19
                Target.Offset(0, 2).Select
            Case 21
                If Target.Offset(0, 2).Value = "JA" Then
                    With Range("C1,E1,G1,I1,K1,M1,O1,Q1,S1,U1,W1")
                        .Offset(Target.Row - 1).Interior.ColorIndex = 35
                        .Offset(Target.Row - 1).Font.ColorIndex = 10
                    End With
                Else
                    With Range("C1,E1,G1,I1,K1,M1,O1,Q1,S1,U1,W1")
                        .Offset(Target.Row - 1).Interior.ColorIndex = 38
                        .Offset(Target.Row - 1).Font.ColorIndex = 53
                    End With
                End If
                If Target.Row < 59 Then
                    Cells(Target.Row + 1, 5).Select
                Else
                    Cells(10, 5).Select
                End If
            Case Else
        End Select
    End If
End If
End Sub

Ich hoffe es passt so, Tobias
http://www.tobiasschmid.de/

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Effektiv Code-Zeilen sparen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread