Zeilen auf bestimmte Blätter verschieben
03.02.2007 13:36:50
H.Schult
Ich habe eine Exelmappe (Abrechnung) mit folgenden Blättern:
1. Arztrechnungen
2. 2006
3. 2007
4. 2008
5. 2009
6. 2010
7. Arztbesuche
Ab Spalte A8 -Arztrechnungen- werden Daten eingetragen. In die Spalte F und G werden Daten zu einem späteren Zeitpunkt zugetragen, die ich extern bekomme. Letzter Eintrag ist in Spalte G zu tätigen. Wenn dieser Eintrag durchgeführt wird, wird die gesammte Zeile anschließend auf das Blatt 2007 verschoben. Hier müßte vorher durch das Programm geprüft werden,auf welches Blatt die Zeile kopiert werden soll.In Zeile L8 wird im Laufe der Dateneingabe folgendes eingetragen: 4-2007. Vielleicht kann man hieraus die Abfrage nach dem Speicherort ableiten?
folgender Code ist bereits in der Mappe vorhanden:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim loZeile As Long, LoLetzte As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("2007")
.Unprotect
LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
End With
With Worksheets("Arztrechnungen")
.Unprotect
Set Target = Intersect(Target, Range("G8:G58"))
If Target Is Nothing Then GoTo Ende
loZeile = Target.Row
Rows(loZeile).Copy
Worksheets("2007").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormulas, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Rem hier wird die kopierte zeile gelöscht
.Rows(loZeile).EntireRow.Delete
Application.CutCopyMode = False
Ende:
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
Application.EnableEvents = True
Worksheets("2007").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
End Sub
Ich wäre dankbar, wenn mir in dieser Sache geholfen werden kann, da ich absoluter Anfänger in VBA bin.
Gruß H.Schult