AW: Zelle mittels VB in anderes Tabellenblatt
17.08.2007 13:06:52
chris58
Danke... das funktioniert wunderbar in einem neuen Tabellenblatt. Nur leider weiß ich jetzt nicht, wo ich diesen Code in meinen code (hat mir freundlicherweise wer geschrieben) einbauen kann.
ich habe Ihn nach "Dim iLfd_Nr As Integer" reingegeben, doch da kommen immer Laufzeitfehler.
Kannst du mir nochmal helfen ?
Danke im voraus
chris
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long
Dim sSheet As String
Dim iLfd_Nr As Integer
If Target.Column = 2 And Target.Row > 3 And Target.Rows.Count = 1 Then
If Target.Value > WorksheetFunction.Max(Range("B3:B" & Target.Row - 1)) Then
If Application.WorksheetFunction.CountIf(Worksheets _
("Neuwagen").Range("B3:B1000"), Target.Value) 0 Or _
Application.WorksheetFunction.CountIf(Worksheets _
("Erledigt").Range("B3:B1000"), Target.Value) 0 Then
MsgBox "Die eingetragene laufende Nummer """ & Target.Value & _
""" gibt es bereits - bitte eine neue Nummer eingeben.", _
48, " Hinweis für " & Application.UserName
Target.Value = ""
Cells(Target.Row, 2).Select
Exit Sub
End If
End If
End If
If Not ((Target.Column = 9 Or Target.Column = 10) And _
Target.Row > 3 And Target.Rows.Count = 1) Then GoTo leave_sub
On Error GoTo leave_sub
Application.EnableEvents = False
If IsDate(Target) Then ' Abfrage, ob Datum
sSheet = IIf(Target.Column = 9, "Erledigt", "Neuwagen")
lRow = Sheets(sSheet).Range("A" & Sheets(sSheet).Rows.Count).End(xlUp).Row + 1
ActiveSheet.Range(Cells(Target.Row, 1), Cells(Target.Row, 10)).Copy
Sheets(sSheet).Cells(lRow, 1).PasteSpecial Paste:=xlPasteValues
If sSheet = "Erledigt" Then
Sheets(sSheet).Cells(lRow, 1).PasteSpecial Paste:=xlPasteFormats
ActiveSheet.Cells(Target.Row, 1).EntireRow.Delete (xlUp)
Sheets(sSheet).Cells(lRow, 11) = Date
MsgBox "Wurde in die Datei [Erledigt] kopiert" & vbCrLf & _
"und in der Datei [Dok.Ink] gelöscht!", _
vbOKOnly + vbInformation, "Erledigen"
Else
Sheets(sSheet).Cells(lRow, 11).Value = Date
MsgBox "Datensatz wurde in Datei [" & sSheet & "] kopiert!", _
vbOKOnly + vbInformation, "Kopieren"
End If
End If
leave_sub:
Application.EnableEvents = True
End Sub