VBA Zeile nicht überschreiben und Position wählen

[MariaL.]

Hallo zusammen,
ich versuche gerade, einen VBA-Code auf meine Bedürfnisse anzupassen, doch leider scheitere ich kurz vor dem Ziel. Bin auch noch Anfängerin.

Ich möchte aus einer Tabelle eine Zeile ausschneiden und in eine Tabelle auf einem anderen Arbeitsblatt in die nächste freie Zeile einfügen. Obwohl ich hier mit xlUp arbeite, wird die Zeile immer in Zeile 24 der Zieldatei eingefügt und nicht in die nächste freie Zeile. Der Rest funktioniert aber gut. Könnt ihr mir hier weiterhelfen? Und wenn es nicht zu viel Mühe macht würde ich mich noch über einen Tipp freuen, wie ich es anstellen kann, dass ich mich nicht nur in Spalte 1, sondern auch in anderen Spalten der entsprechenden Zeile befinden kann, um diese zu verschieben.   Danke, Maria


Option Explicit

Sub Schüler_archivieren()
'Abfrage, ob Schüler wirklich archiviert werden soll
Dim Antwort
Antwort = MsgBox("Schülerin/Schüler archivieren?", vbYesNo + vbQuestion, "Schüler archivieren?")
If Antwort = vbYes Then

    Dim lngErste As Long
    If ActiveCell.Column = 1 Then
        If ActiveCell.Count = 1 Then
                            With Worksheets("Archiv")
                    lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
                        .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
                    ActiveCell.EntireRow.Copy
                    .Cells(lngErste, 1).PasteSpecial Paste:=xlValues
                    ActiveCell.EntireRow.Delete shift:=xlUp
                End With
            End If
        End If
       End If
    End Sub

[BoskoBiati]

Hi,

sollte so funktionieren:

Code:

Sub Schüler_archivieren()
'Abfrage, ob Schüler wirklich archiviert werden soll
Dim Antwort As Long
Dim lngErste As Long
If ActiveCell.Column <> 1 Or Selection.Count <> 1 Then Exit Sub

Antwort = MsgBox("Schülerin/Schüler archivieren?", vbYesNo + vbQuestion, "Schüler archivieren?")
If Antwort = vbYes Then
    With Worksheets("Archiv")
        lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
        ActiveCell.EntireRow.Copy
        .Cells(lngErste, 1).PasteSpecial Paste:=xlValues
        ActiveCell.EntireRow.Delete shift:=xlUp
    End With
End If
End Sub

für lngErste sollte das reichen:

Code:

lngErste = .Cells(.Rows.Count, 1).End(xlUp).Row + 1

[MariaL.]

Hallo Edgar,

vielen Dank. Ich konnte den Code jetzt kürzen und kann mich in jeder Zelle der Zeile befinden. Das ist schon mal super.

Leider wird die kopierte Zeile immer nur in die Zeile 24 eingetragen. Siehe Anhang. Irgendwas mach ich da wohl noch falsch... Danke, Maria

Option Explicit

Sub Schüler_archivieren()
'Abfrage, ob Schüler wirklich archiviert werden soll
Dim Antwort

Antwort = MsgBox("Schülerin/Schüler archivieren?", vbYesNo + vbQuestion, "Schüler archivieren?")
If Antwort = vbYes Then

    Dim lngErste As Long
   
    With Worksheets("Archiv")
        lngErste = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        ActiveCell.EntireRow.Copy
        .Cells(lngErste, 1).PasteSpecial Paste:=xlValues
        ActiveCell.EntireRow.Delete shift:=xlUp
    End With
End If
End Sub

[BoskoBiati]

Hi,

1. es kann eigentlich nur beim ersten Durchlauf die Zeile 24 sein, bei jedem weiteren Start müsste es weiter gehen.
2. Lösche mal die Zellen von A19 bis A23, da muß ja irgendwas drin sein!
3. Dim-Anweisungen sollten immer am Anfang des Codes stehen. Die korrekte Anweisung für Antwort lautet: Dim Antwort as boolean, wobei die Variable besser blANtwort heißen sollte.
4. Es ist bei Deinem Code möglich mehrere Zeilen auf einmal auszuwählen, ist das gewollt?

[MariaL.]

Hallo Edgar, es funktioniert.

Danke für den Hinweis mit dem Löschen der Zeilen. Da waren noch Zeichen drinnen, die aufgrund der Formatierung nicht zu sehen waren.

Aber mehrere Zeilen auswählen möchte ich eigentlich nicht. Es soll immer nur eine ausgewählt werden - und zwar die, in der ich mich befinde.

Funktioniert aber jetzt prima, bin jetzt wirklich erleichtert. Maria

[BoskoBiati]

Hi,

Es soll immer nur eine ausgewählt werden

Dein Code kontrolliert das aber nicht, d.h. wenn Du aus Versehen zwei Zeilen auswählst, werden auch 2 Zeilen kopiert!

Diese Zeile sollte dann am Anfang stehen:

Code:

If Selection.Count <> 1 Then Exit Sub