Change Code Zusammenlegen

Hallo Excel-Spezialisten !
Ich habe hier 2 VBA Codes die ich unter einen Hut bringen will. Da ich jedoch so gut wie keine Kenntnis von VBA habe und ich diese hier gefunden habe und ich diese Codes brauchen kann, jedoch wie es scheint nicht beide in ein Tabellenblatt hineinbringen kann, denn dann kommt eine Fehlermeldung, ersuche ich euch, mir zu schreiben, wie ich diese beiden gemeinsam in ein Tabellenblatt bringen kann, sodaß sie funktionieren. Danke im voraus
Tomi


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim dRow As Double
If Intersect(Range("A3:G4000"), Target) Is Nothing Then Exit Sub
For dRow = Target.Row To Target.Row + Target.Rows.Count - 1
Cells(dRow, 11).Value = Date
Next dRow
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long
If Not ((Target.Column = 8 _
Or Target.Column = 9) And _
Target.Row > 1) Then GoTo leave_sub
On Error GoTo leave_sub
If IsDate(Target) Then ' Abfrage, ob Datum
lRow = Sheets("Erledigt").Range("H" & Sheets("Erledigt").Rows.Count).End(xlUp).Row + 1
ActiveSheet.Range(Cells(Target.Row, 1), Cells(Target.Row, 9)).Copy
Sheets("Erledigt").Cells(lRow, 1).PasteSpecial Paste:=xlPasteValues
Target.EntireRow.Delete (xlUp)
MsgBox "Datensatz wurde archiviert!", vbOKOnly + vbInformation, "Archiv"
End If
leave_sub:
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim lRow As Long If Not ((Target.Column = 8 _ Or Target.Column = 9) And _ Target.Row > 1) Then If Intersect(Range("A3:G4000"), Target) Is Nothing Then Exit Sub Application.EnableEvents = False For lRow = Target.Row To Target.Row + Target.Rows.Count - 1 Cells(lRow, 11).Value = Date Next lRow Application.EnableEvents = True Exit Sub End If On Error GoTo leave_sub If IsDate(Target) Then ' Abfrage, ob Datum Application.EnableEvents = False lRow = Sheets("Erledigt").Range("H" & Sheets("Erledigt").Rows.Count).End(xlUp).Row + 1 ActiveSheet.Range(Cells(Target.Row, 1), Cells(Target.Row, 9)).Copy Sheets("Erledigt").Cells(lRow, 1).PasteSpecial Paste:=xlPasteValues Sheets("Erledigt").Cells(lRow, 1).PasteSpecial Paste:=xlPasteFormats Target.EntireRow.Delete (xlUp) MsgBox "Datensatz wurde archiviert!", vbOKOnly + vbInformation, "Archiv" Application.EnableEvents = True End If leave_sub: End Sub

Hallo
"..Du entäuscht mich... Punkt 2..."
Weshalb,... ich dachte das hätte ich ausreichend erklärt in meinem Beitrag.
Es geht um die Variante wie der Code hier gezeigt wurde.
Und da kann ja wohl niemand davon ausgehen, sofern er das nicht programmiert hat, dass der Code dazu gemacht wurde, ein Datum einzutragen wenn Zeilen oder Bereiche in die Tabelle kopiert werden.
Mit deinem Hintergrundwissen und wozu das gut sein soll,... Respekt. Elegante Lösung.
Nur noch so ein kleiner Hinweis am Rande zur weiteren Verbesserung :-)
Wenn du
... einen Bereich gleich oder grösser als drei Zeilen/Zellen kopierst, diesen in dieser Tabelle in die Zeile 1 oder 2!! einfügst, wird der Code auch ausgeführt. Die Abfrage Intersect greift hier nicht, da Target hier beim Einfügen die Zeile 3 tangiert und somit aktiv ist
If Target.Cells(1,1) >= 3
Damit kannst du die erste Zeile des ausgewählten Bereiches abfragen und allenfalls einen manuellen Einfügevorgang abrrechen
...in dieser Tabelle ganze Spalten löscht im Bereich von A:G , soll ja mal vorkommen, ist der Effekt, dass die Spalte K bis zur Zeile 65536 mit dem aktuellen Datum auffüllst :-)
Da würde eine Abfrage über Selection.Rows.Count Sinn machen, wenn die gleich Rows.Count ist, dann würde ich abbrechen oder Rückfragen :-)
So, und nun solls aber gut sein ,.. oder ?
Gruss Rainer

Beliebteste Forumthreads (12 Monate)

21 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread