online 1
gast (50)

/ Forum / Tabellenkalkulation

TabellenkalkulationTabellenkalkulation

Fragevon Phlip vom 17.02.2022, 17:10 Options

Lösung

Makro, um an das Ende einer Liste zu springen

Hallo SN User,

ich suche ein Makro, mit dem ich an das Ende einer Liste springen kann.

Ausgangslage
Ich habe eine Spalte (A), in die Einträge jeweils nur für den aktuellen Anlass eingetragen werden. Nachdem das Thema erledigt ist, sollen diese Einträge in einer anderen Spalte (C) "archiviert" werden, in dem sie an das Ende der in Spalte C bereits vorhandenen Einträge gefügt werden.

Beispiel
Spalte .A | Spalte B
Eintrag 4 | Eintrag 1
Eintrag 5 | Eintrag 2
................ | Eintrag 3

Die Anzahl der Einträge pro Durchgang kann unterschiedlich sein. In diesem Beispiel wurden bereits die Einträge 1-3 archiviert. Nun möchte ich die Einträge 4+5 aus Spalte A an das Ende der Spalte C anfügen.

Problem
Ich zeichne ein Makro auf:
1. Klick auf Zelle A1
2. Einträge 4+5 mit Strg+Shift+CurserDowndann markieren
3. Einträge mit Strg+x ausschneiden
4. Klick auf Zelle C1
5. Mit Strg+CurserDown auf den letzten Eintrag (Nr. 3) der Liste springen
6. Mit CurserDown in die Zelle unterhalb der Liste in Spalte C springen
7. Mit Strg+v den Inhalt einfügen

Der Code des Makros sieht dann wie folgt aus:
Sub Macro13()
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Range("C1").Select
    Selection.End(xlDown).Select
    Range("C4").Select
    ActiveSheet.Paste
End Sub

vermutete Problemursache
Aus meiner Sicht rührt das Problem aus der Zeile Range("C4").Select im Code, weil dort ein fester Zellbezug auf Zelle C4 enthalten ist, wodurch auch bei zukünftigen Durchgängen die neuen Einträge ab C4 eingefügt werden.

Frage
Wie kann ich diesen festen Zellbezug umgehen und einfach ans Ende der Liste gelangen?

Danke vorab für Eure Vorschläge.
Gruß, Phlip


Antwort schreiben

Antwort 1 von Hajo_Zi vom 17.02.2022, 17:19 Options

Hallo Philip,

Option Explicit

Sub Macro13()
    Dim LoLetzte As Long
    Dim LoLetzte2 As Long
    LoLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
    LoLetzte2 = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
    Range(Cells(1, 1), Cells(LoLetzte, 1)).Copy Range("B" & LoLetzte)
    Range(Cells(1, 1), Cells(LoLetzte, 1)).ClearContents
End Sub


Gruß Hajo

Antwort 2 von rainberg vom 17.02.2022, 17:30 Options

Hallo Philip,

oder etwas kürzer

Option Explicit

Sub Macro13()
    Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Cut _
    Range("C" & Cells(Rows.Count, 3).End(xlUp).Row + 1)
End Sub


Gruss
Rainer

Antwort 3 von Phlip vom 17.02.2022, 19:36 Options

Hallo Ihr beiden,

@Hajo: Danke für den Code und die schnelle Antwort. Dein Makro überschreibt mir aber immer die gleichen Zellen, so wie bei meinem ursprünglichen Problem.

@Rainer: Dein Code funktioniert. Jetzt möchte ich allerdings gerne die ausgeschnittenen Zellen auf ein separates Tabellenblatt "Archive" schreiben. Ich dachte, es geht wie folgt:

Sub Macro13()

    Range("D5:D" & Cells(Rows.Count, 1).End(xlUp).Row).Cut _
    Sheets("Archive").Select
    Range("C" & Cells(Rows.Count, 6).End(xlUp).Row + 1)
    
End Sub 

Wenn ich aber den Befehl Sheets("Archive").Select einfüge, wird automatisch ein Leerzeichen nach dem zweiten Range vor der Klammer eingfügt und eine Fehlermeldung ausgegeben, wenn ich das Makro laufen lasse.

Hast Du hierzu noch eine Idee?

Viele Grüße
Phlip

Antwort 4 von Hajo_Zi vom 17.02.2022, 20:03 Options

Hallo Philp,

es fehlte nr +1 und die Spalte war falsch. Von Unterschiedlichen Tabellenm Stand nichts im ersten Beitrag. Mit Ciut habe ich schon schlechte Erfahrung gemacht.

Option Explicit

Sub Macro13()
    Dim LoLetzte As Long
    Dim LoLetzte2 As Long
    LoLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
    With Worksheets("Tabelle2")
        ' kopieren in Spalte B
        LoLetzte2 = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(Rows.Count, 2).End(xlUp).Row, .Rows.Count) + 1
        Range(Cells(1, 1), Cells(LoLetzte, 1)).Copy .Range("B" & LoLetzte)
    End With
    Range(Cells(1, 1), Cells(LoLetzte, 1)).ClearContents
End Sub


Gruß Hajo

Antwort 5 von rainberg vom 17.02.2022, 20:07 OptionsLösung

Lösung
Hallo Philip,

ungetestet:


Option Explicit

Sub Macro13()
    Range("D5:D" & ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row).Cut _
        Sheets("Archive").Range("C" & Sheets("Archive").Cells(Rows.Count, 3).End(xlUp).Row + 1)
End Sub


Gruss
Rainer

Antwort 6 von Phlip vom 17.02.2022, 20:45 Options

Hallo noch mal,

@Hajo: Die unterschiedlichen Tabellenblätter habe ich bei der Eingangsfrage bewusst weggelassen, um das Problem nicht zu sehr zu komplizieren. Auch dachte ich, dass ich den Befehl für das Wechseln des Tabellenblattes schon kannte und mir das dann selbst zurecht basteln könnte. Ich hing ja vor allem daran, dass ich keinen Zähler hinbekommen habe.

Deinen neuen Code habe ich getestet. Er überschreibt noch immer die Archivspalte. Dabei beginnt er in der Reihe, die der Anzahl von Einträgen in der neuen Spalte (A) entspricht.

Bsp.: Ich Spalte A habe ich 3 neue Einträge, in der Archivspalte bereits 7. Dann beginnt das Makro die Archivspalte ab Reihe 3 zu überschreiben, bei 4 neuen Einträgen überschreibt er ab Reihe 4 usw.

@Rainer: Funktioniert. :-)

Vielen Dank Euch beiden und einen schönen Abend.

@Foren admin: In Rainers letztem Beitrag sieht man, dass das "b" von End Sub fehlt. Ich hatte das gleiche Problem heute auch schon mal, als direkt hinter dem "b" der Befehl [ / c o d e ] stand. Fügt man nach dem "b" noch ein Leerzeichen ein, wird es mit abgebildet.

Gruß, Phlip

Antwort 7 von rainberg vom 17.02.2022, 23:05 Options

Hallo Philip,

Hier die Antwort auf Deine Frage per Pager.

Option Explicit

Sub Macro13()
    Range("D5:D" & ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row).Copy _
        Sheets("Archive").Range("C" & Sheets("Archive").Cells(Rows.Count, 3).End(xlUp).Row + 1)
    Range("D5:D" & ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row).ClearContents
End Sub


Gruss
Rainer

Antwort 8 von Phlip vom 18.02.2022, 00:26 Options

Hi Rainer,
hi all,

vielen Dank. Das funktioniert.

Ich habe das jetzt für mehrere Spalten angewendet, wobei die Daten wie folgt von Tabellenblatt 1 zu Tabellenblatt "Archive" übertragen werden sollen:
Spalte B --> Spalte B
Spalte D --> Spalte C
Spalte F --> Spalte D
Sub Macro13()
    Range("B5:B" & ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row).Copy _
        Sheets("Archive").Range("B" & Sheets("Archive").Cells(Rows.Count, 3).End(xlUp).Row + 1)
    Range("B5:B" & ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row).ClearContents
    
    Range("D5:D" & ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row).Copy _
        Sheets("Archive").Range("C" & Sheets("Archive").Cells(Rows.Count, 3).End(xlUp).Row + 1)
    Range("D5:D" & ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row).ClearContents
    
    Range("F5:F" & ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row).Copy _
        Sheets("Archive").Range("D" & Sheets("Archive").Cells(Rows.Count, 3).End(xlUp).Row + 1)
    Range("F5:F" & ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row).ClearContents
End Sub 
Der mittlere Block ist der, über den wir gesprochen haben. Die Blöcke darüber und darunter habe ich modifiziert (Austauschen der Zellbezüge), um weitere Daten auf das Tabellenblatt "Archive" zu übertragen.

Erstaunlicherweise funktioniert das beim unteren Block nicht richtig. Hier werden immer nur die Überschrift (soll nicht kopiert werden) und der erste Eintrag kopiert und auf dem Tabellenblatt "Archive" eine Zeile tiefer als der letzte archivierte Eintrag angezeigt.

Beispiel
Tabellenblatt 1 (Ausgangssituation):
Spalte B | Spalte D | Spalte F
Header1|Header2|Header3
W e rt 1 | W e r t 4 | Wert 7
W e rt 2 | W e r t 5 | Wert 8
W e rt 3 | W e r t 6 | Wert 9

Tabellenblatt "Archive" (Ergebnis):
Spalte B | Spalte C | Spalte D
HeaderA|HeaderB|HeaderC
W e rt 1 | W e r t 4 |
W e rt 2 | W e r t 5 |
W e rt 3 | W e r t 6 |
...............|.................| Header3
...............|.................| Wert 7

Wert 8 und Wert 9 werden nicht übertragen.

Tabellenblatt 1(Ergebnis):
Spalte B | Spalte D | Spalte F
Header1|Header2|
W e rt 1 | W e r t 4 |
W e rt 2 | W e r t 5 | Wert 8
W e rt 3 | W e r t 6 | Wert 9

Ich kann nicht nachvollziehen, warum es bei allen Blöcken funktioniert, nur beim letzten nicht.

Viele Grüße
Phlip

Antwort 9 von rainberg vom 18.02.2022, 11:07 Options

Hallo Philip,

da sind noch einige Fehler vorhanden.
So müsste es funktionieren.

Sub Macro13()
    Range("B5:B" & ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row).Copy _
        Sheets("Archive").Range("B" & Sheets("Archive").Cells(Rows.Count, 2).End(xlUp).Row + 1)
    Range("B5:B" & ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
    
    Range("D5:D" & ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row).Copy _
        Sheets("Archive").Range("C" & Sheets("Archive").Cells(Rows.Count, 3).End(xlUp).Row + 1)
    Range("D5:D" & ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row).ClearContents
    
    Range("F5:F" & ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row).Copy _
        Sheets("Archive").Range("D" & Sheets("Archive").Cells(Rows.Count, 4).End(xlUp).Row + 1)
    Range("F5:F" & ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row).ClearContents
End Sub


Gruss
Rainer

Antwort 10 von Phlip vom 18.02.2022, 21:56 Options

Hallo Rainer,

jetzt funktioniert es. Ein großes DANKESCHÖN.

Viele Grüße
Phlip

Ähnliche Themen

Makro im Makro deaktivieren ?
korfuweb  02.03.2009 - 179 Hits - 7 Antworten

Mit ComboBox in Zelle springen
--dlb--  26.03.2009 - 267 Hits - 2 Antworten

Mit Makro in neu eingefügte Zeile springen
Johannes94  16.08.2009 - 282 Hits - 10 Antworten

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..

Neue Einträge

Version: supportware 1.9.150 / 10.06.2022, Startzeit:Thu Jan 8 21:07:44 2026