Herbers Excel-Forum - das Archiv
Makro vereinfachen: Daten aus Spalten untereinande
Betrifft: Makro vereinfachen: Daten aus Spalten untereinande
von: Patrick
Geschrieben am: 29.12.2006 13:04:15
Hallo zusammen
Ich habe Datensätze in Spalten die untereinander in die Spalten A, B und C eingefügt werden sollen.
Immer drei Spalten zusammen ergeben einen Datenblock. Also A,B und C gehören zusammen, dann D,E und F und so weiter. Total sind es 60 Datenblöcke (letzter: FW, FX, FY). Nun sollen die 59 Datenblöcke die nach dem ersten folgen alle untereinander in den ersten geschrieben werden.
Also die Daten aus D anschliessend an die Daten aus A, E unter A, F unter C, G unter A, H unter B, I unter C usw.
Hier im Forum habe ich folgendes Makro dafür gefunden und angepasst:
Sub test()
' zweiter Block unter den ersten
cb = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("D1:D1000").Cut
Cells(cb + 1, 1).Select
ActiveSheet.Paste
cb = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
Range("E1:E1000").Cut
Cells(cb + 1, 2).Select
ActiveSheet.Paste
cb = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
Range("F1:F1000").Cut
Cells(cb + 1, 3).Select
ActiveSheet.Paste
' dritter Block unter den ersten
cb = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("G1:G1000").Cut
Cells(cb + 1, 1).Select
ActiveSheet.Paste
cb = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
Range("H1:H1000").Cut
Cells(cb + 1, 2).Select
ActiveSheet.Paste
cb = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
Range("I1:I1000").Cut
Cells(cb + 1, 3).Select
ActiveSheet.Paste
' usw...
End Sub
Das funktioniert und ich müsste es noch erweitern, also pro Datenblock ein
cb = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("G1:G1000").Cut
Cells(cb + 1, 1).Select
ActiveSheet.Paste
cb = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
Range("H1:H1000").Cut
Cells(cb + 1, 2).Select
ActiveSheet.Paste
cb = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
Range("I1:I1000").Cut
Cells(cb + 1, 3).Select
ActiveSheet.Paste
einfügen (natürlich mit den jeweils korrekten Spaltennamen).
Gäbe es da nicht eine einfachere Lösung damit das nicht ein superlanges Makro gibt?
Ich hoffe meine Erklärungen sind nicht zu umständlich(?)
Vielen Dank!
Grüsse
Patrick
Betrifft: AW: Makro vereinfachen: Daten aus Spalten unterein
von: Patrick
Geschrieben am: 29.12.2006 13:12:44
Uuups, da hat sich noch ein Tippfehler eingeschlichen...
[...]E unter A[...]
muss natürlich lauten:
E unter B
Sorry!
Grüsse
Patrick
Betrifft: AW: Makro vereinfachen: Daten aus Spalten untereinande
von: Franc
Geschrieben am: 29.12.2006 15:11:36
hoff ich hab mir das so richtig zusammengereimt. ^^ (bin auch noch in der lernphase)
PS: Ich lass die letzte beschreibene Zeile von unten her ermitteln. Das geht natürlich schief, wenn du unter den Datenblöcken noch befüllte zeilen hast. (so stellt man aber sicher, das nicht nur die 1/2 kopiert wird, falls mal eine Leerzeile in den Daten ist)
Sub Datenblöcke()
Application.ScreenUpdating = False
For i = 4 To 60 Step 0 ' geht ab Spalte 4 los und soll mit step 0 auch nicht von selbst höher zählen
For k = 1 To 3 ' steht für die Spalten 1 - 3
zeile = Cells(65535, i).End(xlUp).Row ' letzte Zeile in der zu kopierenden Spalte ermitteln
Range(Cells(1, i), Cells(zeile, i)).Copy ' Cut hat einen Fehler beim einfügen bewirkt
zeile2 = Cells(65535, k).End(xlUp).Row + 1 ' letzte Zeile in der einzufügenden Spalte ermitteln
Cells(zeile2, k).PasteSpecial
Range(Cells(1, i), Cells(zeile, i)).ClearContents
i = i + 1
Next
Next
Application.ScreenUpdating = True
[A1].Select
End Sub
Betrifft: AW: Makro vereinfachen: Daten aus Spalten unterein
von: Patrick
Geschrieben am: 29.12.2006 15:32:35
Hallo Franc und vielen Dank!
Das funktioniert einwandfrei! Ich musste nur noch '60' in
For i = 4 To 60
durch '180' ersetzen, sonst wären einige Spalten nicht verarbeitet worden.
Vielen Dank für Deine schnelle Hilfe!
Grüsse
Patrick