Formatierung nicht mitübernehmen
11.08.2007 17:00:00
chris
Ich stehe vor einem Problem, das ich mit meinen bescheidenen Möglichkeiten nicht lösen kann. Ich habe den code von einem Excel Spezialisten von hier erhalten und kenn mich kaum aus. Was muß ich machen, daß dieser code die Formatierung von der Ursprungsdatei nicht in die Zieldatei mitübernimmt.
Kann mir bitte dabei helfen ?
Danke im voraus
chris
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long
Dim sSheet As String
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-Finanzierung")
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