Excel-Zeile kopieren und in Tabelle 2/3 eintragen

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column 35 Then Exit Sub ' begrenzt die Reaktion auf Aktionen nur in Spalte 35 = _ Spalte AI If Target.Row Date Then ' hier muss der gewünschte _ Name/Datum rein 'wenn alles passt dann Zeile kopieren Sheets("Aufträge").Rows(Target.Row).Copy Destination:=Sheets("Archiv_2016").Rows(myLastRow + 1) End If MsgBox "Abgeschlossener B-Auftrag ins Archivblatt verschoben" Application.ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim myLastRow As Long, jahr As Long ' für die letzte Zeile in Archiv ' Deklarationen zuallererst... If Target.Column 35 Or Target.Row 0 Then On Error GoTo 0 MsgBox "Archiv_" & jahr & " nicht gefunden." Exit Sub End If On Error GoTo 0 myLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 If myLastRow

Private Sub Worksheet_Change(ByVal Target As Range) Dim wksArchiv As Worksheet Dim myLastRow As Long ' für die letzte Zeile in Archiv If Target.Column = 35 Then ' begrenzt die Reaktion auf Aktionen nur in Spalte 35 = _ Spalte AI If Target.Row >= 5 Then 'begrenzt die Reaktion auf Aktionen nur ab Zeile 5 If Me.Cells(Target.Row, 7).Value Date Then ' hier muss der gewünschte Name/Datum _ rein 'Spalte AI auf Datum prüfen If IsDate(Me.Cells(Target.Row, 35).Text) Then 'Datum auf Jahreszahl-Bereich prüfen If Year(Me.Cells(Target.Row, 35)) >= 2016 _ And Year(Me.Cells(Target.Row, 35))

'wenn alles passt dann Zeile kopieren With Me.Rows(Target.Row) .Copy Destination:=wksArchiv.Rows(myLastRow + 1) Me.Unprotect Password:="" .EntireRow.Hidden = True Me.Protect Pasword:="", DrawingObjects:=True, Contents:=True, _ Scenarios:=True End With

Und ich hab' auch noch einen:

Private Sub Worksheet_Change(ByVal Target As Range)
' begrenzt die Reaktion auf Aktionen nur in Spalte 35 = Spalte AI
If Target.Column  35 Then Exit Sub
' begrenzt die Reaktion auf Aktionen nur ab Zeile 5
If Target.Row  1 Then Exit Sub
' letzte Zeile in Archiv
Dim myLastRow As Long
' ermitteln der Jahreszahl
Dim myYear As String
myYear = Year(Cells(Target.Row, Target.Column))
' Copy-Archiv ermitteln
Dim Archiv As String
Archiv = "Archiv_" & myYear
' Gibt es das Archiv überhaupt?
If SheetExist(Archiv) = False Then
MsgBox "Jahr " & myYear & " nicht als Archiv vorhanden": Exit Sub
End If
Application.ScreenUpdating = False
With Worksheets(Archiv)
' sucht die letzte gefüllte Zelle in Spalte A
myLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
' damit beginnt das Füllen erst ab Zeile 5
If myLastRow  Date Then
Worksheets("Aufträge").Rows(Target.Row).Copy _
Destination:=Worksheets(Archiv).Rows(myLastRow + 1)
MsgBox "Abgeschlossener B-Auftrag ins Archivblatt " & myYear & " verschoben"
End If
Application.ScreenUpdating = True
End Sub

Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
Dim wks As Worksheet
On Error GoTo ERRORHANDLER
If Wb Is Nothing Then Set Wb = ThisWorkbook
For Each wks In Wb.Worksheets
If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
Next
ERRORHANDLER:
SheetExist = False
End Function

Gruß
Klaus

Beliebteste Forumthreads (12 Monate)

Excel-Zeile kopieren und in Tabelle 2/3 eintragen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Excel-Zeile kopieren und in Tabelle 2/3 eintragen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread