Zellinhalte untereinander verschieben?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Verschieben() Dim ListenEnde As Long, Zeile As Long, Spalte As Long, EinfZeile As Long EinfZeile = 5 ListenEnde = Range("A1000000").End(xlUp).Row Worksheets.Add For Zeile = 5 To ListenEnde For Spalte = 1 To 6 Cells(EinfZeile, 1).Value = Worksheets("vorher").Cells(Zeile, Spalte).Value EinfZeile = EinfZeile + 1 Next Spalte EinfZeile = EinfZeile + 1 Next Zeile End Sub

Sub Verschieben() Dim ListenEnde As Long, Zeile As Long, Spalte As Long, EinfZeile As Long EinfZeile = 5 ListenEnde = Range("A1000000").End(xlUp).Row 'Worksheets.Add For Zeile = 5 To ListenEnde For Spalte = 1 To 6 Cells(EinfZeile, 1).Value = ActiveSheet.Cells(Zeile, Spalte).Value EinfZeile = EinfZeile + 1 Next Spalte EinfZeile = EinfZeile + 1 Next Zeile End Sub

Hallo Hajo,
meinst du so:


Sub Verschieben()
'Inhalte vob Spalte B:F in Spalte A verschieben und eine leere Zeile einfügen usw. bis letzte Zelle der Spalte A
'Die Formatierung von von Zellen muss beibehalten werden
'Das Makro soll ab Zeile 5 ausgeführt werden
Dim ListenEnde As Long, Zeile As Long, Spalte As Long, EinfZeile As Long
EinfZeile = 6
ListenEnde = Range("A65536").End(xlUp).Row
For Zeile = 1 To ListenEnde
For Spalte = 1 To 7
'Cells(EinfZeile, 1).Value = Worksheets("test").Cells(Zeile, Spalte).Value
'        Cells(EinfZeile, 1).Value = ActiveSheet.Cells(Zeile, Spalte).Value
Cells(Zeile, Spalte).Copy Cells(EinfZeile, 1)
EinfZeile = EinfZeile + 1
Next Spalte
EinfZeile = EinfZeile + 1
Next Zeile
End Sub

Ich habe es in der Originaldatei mit ca. 230 Zeilen ausgeführt. Der Vorgang hat ca. 5 Minuten gedauert und der Rechner war sehr überlastet. :-) Ist das normal?
Ich vermute, dass ich deine Zeile nicht an der richtige Stelle eingefügt habe. Außerdem habe ich festgestellt, dass die Spalten B:F nach dem Ausführen nicht verschoben sondern kopiert wurden. Wahrscheinlich geht es nicht anders, oder?
Datei als Vorlage: https://www.herber.de/bbs/user/146082.xlsm
Gruß Sergej

Sub Verschieben() Dim ListenEnde As Long, Zeile As Long, Spalte As Long, EinfZeile As Long EinfZeile = 5 ListenEnde = Range("A65536").End(xlUp).Row Worksheets.Add For Zeile = 5 To ListenEnde For Spalte = 1 To 6 Worksheets("vorher").Cells(Zeile, Spalte).Copy Cells(EinfZeile, 1) EinfZeile = EinfZeile + 1 Next Spalte EinfZeile = EinfZeile + 1 Next Zeile End Sub

Beliebteste Forumthreads (12 Monate)

Zellinhalte untereinander verschieben?

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread