Makro vereinfachen: Daten aus Spalten untereinande
29.12.2006 13:04:15
Patrick
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