zwei Intersect in Private Sub Worksheet_Change zus

Private Sub Worksheet_Change zusammen zu fügen? Bin ein Anfänger und habe schon sehr viel gelesen und probiert, leider ohne erfolg :-( Code: Private Sub Worksheet_Change(ByVal Target As Range) Dim Zeile As Long Set Target = Intersect(Target, Range("H2:H9000")) If Target Is Nothing Then Exit Sub If Target = "Landlord" Then Zeile = Target.Row Range(Cells(Zeile, 1), Cells(Zeile, 20)).Copy _ Destination:=Sheets("aktive_LL").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) Target.EntireRow.Delete End If Set Target = Intersect(Target, Range("B2:B9000")) If Target Is Nothing Then Exit Sub If Target = "1" Then Zeile = Target.Row Range(Cells(Zeile, 1), Cells(Zeile, 20)).Copy _ Destination:=Sheets("abgeschlossene_SC").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) Target.EntireRow.Delete End If End Sub Besten Dank für Eure unterstützung.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row = 1 Or Target.Count > 1 Then Exit Sub If Target.Column = 8 And Target = "Landlord" Then Range("A" & Target.Row).Resize(, 20).Copy _ Destination:=Sheets("aktive_LL").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) Target.EntireRow.Delete End If If Target.Column = 2 And Target = "1" Then Range("A" & Target.Row).Resize(, 20).Copy _ Destination:=Sheets("abgeschlossene_SC").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) Target.EntireRow.Delete End If End Sub

…Umgang mit SchlüsselBegriffen, die die ForumsSoftwareAutomatik auslösen, zurückzuführen, Ralf;
besser ist es allemal, die HTML-Code-Tags zu benutzen und die Automatik nicht mit Pgm-Kopfzeilen in normalem Text zu provozieren… ;-]
Die PgmZusammenführung könnte so aussehen:

    Dim Ziel As Range
Set Ziel = Intersect(Target, Range("H2:H9000"))
If Not Ziel Is Nothing Then
If Target = "Landlord" Then
Zeile = Target.Row
Me.Range(Cells(Zeile, 1), Cells(Zeile, 20)).Copy _
Destination:=Sheets("aktive_LL").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Target.EntireRow.Delete
End If
Else: Set Target = Intersect(Target, Range("B2:B9000"))
If Target Is Nothing Then Exit Sub
If Target = "1" Then   'Anm: Soll das wirkl 1e TextZahl sein? Sonst =1!
Zeile = Target.Row
Range(Cells(Zeile, 1), Cells(Zeile, 20)).Copy Destination:= _
Sheets("abgeschlossene_SC").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Target.EntireRow.Delete
End If
End If

Man könnte natürlich auch alles in einem Hpt-If-Konstrukt per Or zusammenfassen und dann erst lt Inhalt von Target auf ggf unterschiedliche Verfahren verzweigen, aber das kannst du ja mal selbst entwickeln… ;-)
Gruß, Luc :-?
Besser informiert mit …

If Not (Intersect(Target, Range("H2:H9000")) Is Nothing And _ Intersect(Target, Range("B2:B9000")) Is Nothing) Then Select Case Target Case "Landlord" '… Case 1 '… End Select Else: Exit Sub Endif

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row = 1 Or Target.Count > 1 Then Exit Sub If Target.Column = 8 And Target = "Landlord" Then Range("A" & Target.Row).Resize(, 20).Copy _ Destination:=Sheets("aktive_LL").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) Target.EntireRow.Delete ElseIf Target.Column = 2 And Target.Text = "1" Then ' egal, ob 1 oder "1" Range("A" & Target.Row).Resize(, 20).Copy _ Destination:=Sheets("abgeschlossene_SC").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) Target.EntireRow.Delete End If End Sub

Beliebteste Forumthreads (12 Monate)

zwei Intersect in Private Sub Worksheet_Change zus

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

zwei Intersect in Private Sub Worksheet_Change zus

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

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread