wenn Zelle nicht leer Zeile kopieren in Tabelle

Private Sub Worksheet_Change(ByVal Target As Range) Dim iRow As Integer Application.DisplayAlerts = False If Target.Column 17 Then Exit Sub If IsEmpty(Target) Then Exit Sub If UCase(Target.Value) >= 1 Then With Worksheets("Order-History") iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 Rows(Target.Row).Copy .Rows(iRow) With Worksheets("Comparison") Rows(Target.Row).Delete .Rows(iRow) + 4 End With End With End If Application.CutCopyMode = False Application.DisplayAlerts = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim iRow As Integer Application.DisplayAlerts = False select case Target.Column case 17,18,19 If IsEmpty(Target) Then Exit Sub If not range(cells(target.row,17)) = "" and not range(cells(target.row,18)) = "" and _ not _ range(cells(target.row,19)) = "" Then With Worksheets("Order-History") iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 Rows(Target.Row).Copy .Rows(iRow).insert shift:=xlDown end with With Worksheets("Comparison") Rows(Target.Row).Delete Shift:=xlUp End With end if end select Application.CutCopyMode = False Application.DisplayAlerts = True End Sub

Gebe zu habe mich etwas undeutlich ausgedrückt!
Mein Code hatte sich bisher nur auf die Prüfung der Spalte Q bezogen. Die Erweiterung auf R und S konnte ich nicht integrieren. :-)
Tabelle 1 ist das Comparison Tabellenblatt.
Ich Teste dein Code gleich mal.
Schon jetzt vielen Dank! Ich befürchte nur das ich dem Zusammenhang des kopierens und löschens noch Probleme bekommen werde.
Es dürfen nur die Werte in den Reihen kopiert werden und nicht die dahinterliegenden Formeln.
Genauso beim löschen dürfen nur die Werte in den Zellen gelöscht werden und nicht die eigentliche Zelle. Die Zellen mit den dahinterliegenden Formeln müssen weiterhin bestehen.
Ich hoffe man versteht mich! :-)
Vielen Dank an dich Jürgen!!

Habe den Code von Jürgen noch etwas verändert. Ist das Plausibel?

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:=""
Dim iRow As Integer
Application.DisplayAlerts = False
Select Case Target.Column
Case 17, 18, 19
If IsEmpty(Target) Then Exit Sub
If Not Range(Cells(Target.Row, 17)) = "" And Not Range(Cells(Target.Row, 18)) = "" And  _
Not Range(Cells(Target.Row, 19)) = "" Then
With Worksheets("Order-History")
iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Rows(Target.Row).Copy
.Rows(iRow).Insert Shift:=xlDown
ActiveWorkbook.Sheets("Comparison").Select
ActiveSheet.Unprotect Password:=""
ActiveSheet.Rows(Target.Row + 4).Delete Shift:=xlUp
End With
End If
End Select
Application.CutCopyMode = False
Application.DisplayAlerts = True
End Sub

Ich habe noch die Password-Sache mit reingebracht und beim Tabellenblatt COMPARISON die plus 4 bei (Target.Row +4) gesetzt. Das ist nötig weil im Tabellenblatt COMPARISON die Zeilen um 4 nach unten verschoben sind.
Jetzt spuckt er mir eine Fehlermeldung aus.
Laufzeitfehler 1004
Die Methode 'Range' für das Objekt '_WorkSheet' ist fehlgeschlagen.
Beim Debuggen wird diese Zeile makiert:
If Not Range(Cells(Target.Row, 17)) = "" And Not Range(Cells(Target.Row, 18)) = "" And Not Range(Cells(Target.Row, 19)) = "" Then

Private Sub Worksheet_Change(ByVal Target As Range) ActiveSheet.Unprotect Password:="leonardtony!1" Dim iRow As Integer Application.DisplayAlerts = False Select Case Target.Column Case 17, 18, 19 If IsEmpty(Target) Then Exit Sub If UCase(Cells(Target.Row, 17)) >= 1 And UCase(Cells(Target.Row, 18)) >= 1 And UCase( _ Cells(Target.Row, 19)) >= 1 Then With Worksheets("Order-History") iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 Rows(Target.Row).Copy .Rows(iRow).Insert Shift:=xlDown ActiveWorkbook.Sheets("Comparison").Select ActiveSheet.Unprotect Password:="leonardtony!1" ActiveSheet.Rows(Target.Row + 4).Delete Shift:=xlUp End With End If End Select Application.CutCopyMode = False Application.DisplayAlerts = True End Sub

Beliebteste Forumthreads (12 Monate)

wenn Zelle nicht leer Zeile kopieren in Tabelle

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

388 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

wenn Zelle nicht leer Zeile kopieren in Tabelle

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

388 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread