Kopieren und löschen mit Datumseingabe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim n As String Dim r As Integer If Not Intersect(Target, Range("H2:H3000")) Is Nothing Then ' Eingabebereich If IsDate(Target) Then ' Abfrage, ob Datum Application.ScreenUpdating = False n = ActiveWorkbook.Name Workbooks.Open Filename:="C:\Dokumente und Einstellungen\Christian\Desktop\Erledigt.xls" ' _ Hier dein Pfad With Workbooks(n) r = Target.Row nachricht = MsgBox("Möchten Sie die Zeile wirklich löschen ?", vbYesNo) ' abfrage, _ ob löschen If nachricht = vbYes Then ' bei ja löschen und kopieren .Sheets(1).Range("A" & r & ":G" & r).Copy Destination:=Workbooks("Erledigt.xls"). _ Sheets(1).Range("A65536").End(xlUp).Offset(1, 0) .Sheets(1).Range("A" & r & ":G" & r).Delete Else Target.ClearContents ActiveWorkbook.Save ActiveWorkbook.Close Application.ScreenUpdating = True ' bei nein nichts Exit Sub End If End With ActiveWorkbook.Save ActiveWorkbook.Close Application.ScreenUpdating = True End If End If End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim n As String Dim r As Integer If Not Intersect(Target, Range("H2:H3000")) Is Nothing Then If IsDate(Target) Then Application.ScreenUpdating = False n = ActiveWorkbook.Name Workbooks.Open Filename:="C:\Dokumente und Einstellungen\Christian\Desktop\Erledigt.xls" With Workbooks(n) r = Target.Row nachricht = MsgBox("Möchten Sie die Zeile wirklich löschen ?", vbYesNo) If nachricht = vbYes Then .Sheets(1).Range("A" & r & ":G" & r).Copy Destination:=Workbooks("Erledigt.xls"). _ Sheets(1).Range("A65536").End(xlUp).Offset(1, 0) .Sheets(1).Range("A" & r & ":G" & r).Delete Target.ClearContents Else Target.ClearContents ActiveWorkbook.Save ActiveWorkbook.Close Application.ScreenUpdating = True Exit Sub End If End With ActiveWorkbook.Save ActiveWorkbook.Close Application.ScreenUpdating = True End If End If End Sub

Danke für deine Mühe, es klappt wenn ich die Datei "Erledigt" nicht öffne.
2 Fragen hätte ich noch:
1. Kann man das ganze auch als als Tabellenblatt im gleichen Excel Tool haben ? und
2. Wie kann man die Formel umändern, das die Zeile zwar kopiert aber nicht gelöscht wird ?
Denn es geht so, ich habe die Datei mit den Typenscheinen, hier werden sie eingetragen
dann werden diese mit 90% Vorfinanziert und sollen noch nicht erledigt sein, sie kommen nur auf eine andere Liste. Wenn das Auto dann verkauft wird, dann sollen sie in die Erledigten kommen. Wäre nett wenn du mir helfen würdest, denn es ist immer ein Riesenaufwand mit zwei Listen und den Datums usw. zu jonglieren. Ich werde mir dann die Listen zusammenstoppeln und hoffe ich komm auf einen grünen Zweig. Jedenfalls danke nochmal, das erste hat mir shcon sehr geholfen.
lg
chris

Servus Chris,


Private Sub Worksheet_Change(ByVal Target As Range)
Dim n As String
Dim r As Integer
If Not Intersect(Target, Range("G2:G3000")) Is Nothing Then ' Eingabebereich
If IsDate(Target) Then ' Abfrage, ob Datum
Application.ScreenUpdating = False
n = ActiveWorkbook.Name
Workbooks.Open Filename:="C:\Documents and Settings\stadter\Desktop\Erledigt.xls" ' _
Hier dein Pfad
With Workbooks(n)
r = Target.Row
nachricht = MsgBox("Möchten Sie die Zeile wirklich löschen ?", vbYesNo) ' abfrage, _
ob löschen
If nachricht = vbYes Then ' bei ja löschen und kopieren
.Sheets("Übersicht").Range("A" & r & ":G" & r).Copy Destination:=Workbooks(" _
Erledigt.xls"). Sheets(1).Range("A65536").End(xlUp).Offset(1, 0)
Else
Target.ClearContents
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True ' bei nein nichts
Exit Sub
End If
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True
End If
End If
End Sub

Was meinst du mit im gleichen Excel-Tool ? In der selben Arbeitsmappe, z.B.: Sheets("Erledigt") ? Wenn du das meintest, dann ja. das geht ohne weiteres.
Habe dir im Code die Zeile, die fürs Löschen verantwortlich ist rausgenommen.
Gruß
Chaos

Beliebteste Forumthreads (12 Monate)

Kopieren und löschen mit Datumseingabe

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread