Drei Private Sub Worksheet_Change zusammen führen

Question

Hallo Leute,

ich habe drei "Private Sub Worksheet_Change" die einzeln funktionieren.
Diese möchte ich jedoch in einer Tabelle benutzen.
Ich habe schon raus bekommen das man diese zu einen "Sub Worksheet_Change" zusammen fassen muss.
Ich habe es schon mal selbst probiert doch mit meinen minimalen Kenntnisen im VBA bekomme ich es nicht hin.

Ich hoffe das mir jemand von euch helfen kann und bedanke mich schon mal für eure Zeit.

Meine Private Sub Worksheet_Change sind wie folgt aufgebaut.

1.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B1:B1000")) Is Nothing Then Exit Sub
        If Target.Count > 1 Then Exit Sub
            If Target = "" Then
                Target.Offset(0, 5).ClearContents
                Else:
                Target.Offset(0, 5) = CDate(Format(Now, "dd.mm.yyyy"))
        End If

End Sub

2.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("I1:I1000")) Is Nothing Then Exit Sub
        If Target.Count > 1 Then Exit Sub
            If Target = "1" Then
                Target.Offset(0, 1) = CDate(Format(Now, "dd.mm.yyyy"))
                Else:
                Target.Offset(0, 1).ClearContents
            End If
End Sub

3.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lngErste As Long
        If Target.Column = 10 Then 'Spalte J
            If Target.Count = 1 Then
                If IsDate(Target) Then
                    With Worksheets("Abgeschlossen")
                        lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
                            .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
                        Rows(Target.Row).Copy
                        .Cells(lngErste, 1).PasteSpecial Paste:=xlValues
                        Rows(Target.Row).Delete shift:=xlUp
                    End With
                End If
            End If
        End If
End Sub

Answer 1

Hi,

ungetestet:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lngErste As Long
    If Not Intersect(Target, Range("B1:B1000")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        If Target = "" Then
            Target.Offset(0, 5).ClearContents
            Else:
            Target.Offset(0, 5) = CDate(Format(Now, "dd.mm.yyyy"))
        End If
    ElseIf Not Intersect(Target, Range("I1:I1000")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        If Target = "1" Then
            Target.Offset(0, 1) = CDate(Format(Now, "dd.mm.yyyy"))
            Else:
            Target.Offset(0, 1).ClearContents
        End If
    Else
        If Target.Column = 10 Then 'Spalte J
            If Target.Count = 1 Then
                If IsDate(Target) Then
                    With Worksheets("Abgeschlossen")
                        lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
                            .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
                        Rows(Target.Row).Copy
                        .Cells(lngErste, 1).PasteSpecial Paste:=xlValues
                        Rows(Target.Row).Delete shift:=xlUp
                    End With
                End If
            End If
        End If
    End If
End Sub

Frage: weshalb schreibst du in der Zeile If Target = "1" die 1 in Anführungszeichen?? 1 ist doch eine Ziffer und kein Text - nur Text setzt man in "".

Bis später, Karin

Answer 2

Funktioniert perfekt, vielen Dank für die schnelle Hilfe!

Die "1" war noch ein fehler meinerseits da ich das erste Private Sub Worksheet_Change für das zweite kopiert und umgeschrieben habe.