Zeile ausschneiden und in anderes Tabellenblatt einfügen

Hallo VBA'ler,

es ist zwar früh am Morgen, aber mein Hirn bekommt es nicht auf die Reihe.

Ich möchte in einem Tabellenblatt eine Zeile ausschneiden und in einem anderen Tabellenblatt am Ende wieder einfügen. Irgendwie funzt das nicht. Wo ist mein Denkfehler?
Hoffe, jemand hat mir eine Lösung zu diesem kleinen Problem.

Sub KundenLoeschen()

'Abfrage ob Kunde wirklich gelöscht werden soll
Dim Antwort

Antwort = MsgBox("Soll der Eintrag wirklich gelöscht werden?", vbYesNo + vbQuestion, "Eintrag wirklich löschen?")
If Antwort = vbYes Then ActiveCell.EntireRow.Cut

'Hier wird die letzte Zeile ermittelt
'Egal in welcher Spalte sich die letzte Zeile befindet
'Es werden alle Spalten geprüft und die letzte Zeile ausgegeben

Sheets("gekündigte Verträge").Select
Range("A1").Select
letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveSheet.Cells(letztezeile, 1).Select
ActiveSheet.Cells(letztezeile, 1).Paste

End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

'Hier wird die letzte Zeile ermittelt 'Egal in welcher Spalte sich die letzte Zeile befindet 'Es werden alle Spalten geprüft und die letzte Zeile ausgegeben letztezeile = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row

Option Explicit Sub KundenLoeschen() Dim rngToDelete As Range Dim rngToMoveTo As Range Dim lngAntwort As Long If ActiveCell.Worksheet.Name > Tabelle1.Name Then MsgBox "Falsches Arbeitsblatt für diese Aktion" Exit Sub End If If Intersect(ActiveCell, Tabelle1.UsedRange) Is Nothing Then MsgBox "Bitte zuerst einen Kundeneintrag auswählen" Exit Sub Else If Cells(ActiveCell.Row, 1).Value = "" Or ActiveCell.Row = 1 Then MsgBox "Bitte zuerst einen Kundeneintrag auswählen" Exit Sub Else lngAntwort = MsgBox("Soll der Kunde " & Cells(ActiveCell.Row, 1) & " wirklich gelöscht werden?", _ vbYesNo + vbQuestion, "Eintrag wirklich löschen?") If lngAntwort = vbNo Then Exit Sub End If End If End If 'jetzt erst wirklich etwas tun Set rngToDelete = ActiveCell.EntireRow Set rngToMoveTo = Tabelle2.Cells(Tabelle2.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).EntireRow rngToDelete.Cut rngToMoveTo rngToDelete(1).Delete End Sub

Option Explicit Sub KundenLoeschen() Dim rngToDelete As Range Dim rngToMoveTo As Range Dim lngAntwort As Long Dim lngRow As Long If ActiveCell.Worksheet.Name > Tabelle1.Name Then MsgBox "Falsches Arbeitsblatt für diese Aktion" Exit Sub End If If Cells(ActiveCell.Row, 1).Value = "" Or ActiveCell.Row = 1 Then MsgBox "Bitte zuerst einen Kundeneintrag auswählen" Exit Sub Else lngAntwort = MsgBox("Soll der Kunde " & Cells(ActiveCell.Row, 1) & " wirklich gelöscht werden?", _ vbYesNo + vbQuestion, "Eintrag wirklich löschen?") If lngAntwort = vbNo Then Exit Sub End If End If lngRow = ActiveCell.Row Set rngToDelete = ActiveCell.EntireRow Set rngToMoveTo = Tabelle2.Cells(Tabelle2.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).EntireRow rngToDelete.Cut rngToMoveTo 'mit dem Verschieben ändert sich die Adresse von rngToDelete Tabelle1.Rows(lngRow).EntireRow.Delete End Sub

Jetzt hab ich aber genug herumgespielt :)

Option Explicit

Sub KundenLoeschen()



Dim wksKunde As Worksheet

Dim wksExKunde As Worksheet

Dim rngToDelete As Range

Dim rngToMoveTo As Range

Dim lngAntwort As Long

Dim lngRow As Long



'Hier die Workbooks als Variablen zur einfachern Anpassung des Codes

Set wksKunde = ThisWorkbook.Worksheets("Gesamtuebersicht")      ' alternativ den Code Namen z.B.: Tabelle1

Set wksExKunde = ThisWorkbook.Worksheets("gekündigte Verträge") ' alternativ den Code Namen z.B.: Tabelle2



' Zeile der aktiven Zelle

lngRow = ActiveCell.Row



If Not ActiveCell.Worksheet Is wksKunde Then

    'Die aktive Zelle liegt nicht auf dem richtigen Worksheet

    'debug.print activeCell.Worksheet.Name

    MsgBox "Falsches Arbeitsblatt für diese Aktion"

    Exit Sub

End If

If IsEmpty(wksKunde.Cells(lngRow, 1)) Or lngRow = 1 Then

    'entweder ist bei der aktiven Zelle die erste Spalte leer, oder sie liegt in der Titelzeile (Zeile 1)

    MsgBox "Bitte zuerst einen Kundeneintrag auswählen"

    Exit Sub

Else

    'alles scheint ok, jetzt noch den Anwender fragen, ob er die Zeile löschen will

    lngAntwort = MsgBox("Soll der Kunde " & wksKunde.Cells(lngRow, 1) & " wirklich gelöscht werden?", _

                        vbYesNo + vbQuestion, "Eintrag wirklich löschen?")

    If lngAntwort = vbNo Then

        Exit Sub

    End If

End If

'Das folgende wird nur ausgeführt wenn kein Fehler erkannt wurde und der Anwender dem Löschen zugestimmt hat



Set rngToDelete = ActiveCell.EntireRow

Set rngToMoveTo = wksExKunde.Cells(wksExKunde.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).EntireRow



rngToDelete.Cut rngToMoveTo

'rngtoDelete nochmals setzen, da rngToDelete.Cut die Addresse von rngToDelete ändert

Set rngToDelete = ActiveCell.EntireRow

rngToDelete.Delete



End Sub

Beliebteste Forumthreads (12 Monate)

Zeile ausschneiden und in anderes Tabellenblatt einfügen

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeile ausschneiden und in anderes Tabellenblatt einfügen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread