Supportnet / Forum / Tabellenkalkulation

Hallo Exelfreaks Ich benötige bitte Hilfe bei folgenden Problem. Ich einer bestimmten Zeile wird als Bestätigung in einer ZELLE ein Wert eingetragen. Mittels VBA wird dann diese Zeile auf ein anderes Exelblatt kopiert. Ich möchte aber erreichen, daß die Zeile verschoben wird. Mein VBA-Code füge ich mal zum besseren Verstehen bei: Private Sub Worksheet_Change(ByVal Target As Range) Dim Zeile As Variant ActiveSheet.Unprotect Sheets("Index").Select ActiveSheet.Unprotect Sheets("Arztrechnungen").Select Application.ScreenUpdating = False Set Target = Intersect(Target, Range("G8:G53")) If Target Is Nothing Then Exit Sub End If If ActiveCell = "" Then Exit Sub Else Zeile = ActiveCell.Row Rows(Zeile).Copy Sheets("Index").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormulas, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False End If ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True Sheets("Index").Select ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True Sheets("Arztrechnungen").Select Application.ScreenUpdating = True End Sub Vielen Dank schon mal im Voraus ACR

hi tuccon :-)

was spricht dagegen nach dem kopieren die zeile zu loeschen ?

gruss nighty

Hi nighty

Das Problem ist nicht , daß die Zeile von Blatt 1 kopiert wird, sondern das sie im Anschluß nach dem Kopieren nach Blatt 2 gelöscht wird....
Oder anders ausgedrückt: Die Zeile von Blatt 1 soll nach Blatt 2 verschoben werden.
Vielleicht kann man den Code entsprechend ändern?


Gruß ACR

hi tuccon :-)

verschieben ist nix anderes wie kopieren mit anschliessenden löschen

gruss nighty

rem copy zeile

Rows(Zeile).Copy
Sheets("Index").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormulas, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

nach dieser

rem löschzeile

Sheets("Arztrechnungen").Rows(Zeile).Delete Shift:=xlUp

Hi nighty

Zunächst mal vielen Dank für das schnelle Antworten.
Werde die Änderung im Code morgen ausprobieren. Hoffe es klappt so...

Schönen Abend (Eventuell bis Morgen)

ACR

Hi nighty

Habe heute Deinen Vorschlag ausprobiert.
Ergebnis: Es funktioniert, wenn man anschließend
ALLE Zeilen löschen will. Ich möchte aber nur EINE bestimmte Zeile löschen. Bedingung war hierzu, daß in Zelle G8 bis G53 ein Eintrag vorhanden ist.
Vielleicht kann ich ja noch mal auf Deine Hilfe hoffen.

Gruß ACR

hi tuccon :-)

gruss nighty

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zeile As Variant
ActiveSheet.Unprotect
Sheets("Index").Select
ActiveSheet.Unprotect
Sheets("Arztrechnungen").Select
Application.ScreenUpdating = False
Set Target = Intersect(Target, Range("G8:G53"))
If Target Is Nothing Then
Exit Sub
End If
If ActiveCell = "" Then
Exit Sub
Else
Zeile = ActiveCell.Row
Rows(Zeile).Copy
Sheets("Index").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
Sheets("Arztrechnungen").Rows(Zeile).Delete Shift:=xlUp
Application.CutCopyMode = False
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Index").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Arztrechnungen").Select
Application.ScreenUpdating = True
End Sub

Hi nighty

Vielen Dank für Deine Bemühungen
Es funktioniert nur dann, wenn in der letzten Zeile des ausgefüllten Bereiches ein Eintrag gemacht wird, ansonsten werden wie in Deinem Beispiel vorher ALLE Zeilen kopiert und anschließend gelöscht.Zum besseren Verständnis: Es handelt sich bei der Tabelle um Rechnungssätze, die erst nach Blatt 2 übernommen werden, wenn der ausstehende Betrag gutgeschrieben wurde und in Zelle G8 für diese Zeile bestätigt wurde.
Ist noch Hilfe möglich??

Gruß ACR

Hallo ihr Freaks....

Weiß denn keiner eine Lösung für mein Problem????
Wäre schön, wenn ich bei Euch Hilfe bekommen würde.

Gruß
tuccon2003

Hi,

vielleicht hilft dir dieser Code

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim loZeile As Long, loLetzte As Long
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    With Worksheets("Index")
        .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:G53"))
        If Target Is Nothing Then GoTo Ende
        loZeile = Target.Row
        Rows(loZeile).Copy
        Worksheets("Index").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("Index").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Application.ScreenUpdating = True
End Sub

Bis später,
Karin

Hi Karin

Das war meine Rettung....
Genau so hatte ich es mir vorgestellt. Code eingefügt, ausprobiert und Ergebnis:
ES FUNKTIONIERT !!!!

Super Vielen Dank für die Hilfe

M.f.G.
tuccon2003

• Bereich verschieben?
• Makro soll die richtige Zeile finden
• Bereich nach unten verschieben !!!
• Excel: Zelleninhalte systematisch verschieben