Blöcke in neue Spalte kopieren

08/03/2009 - 10:24 von Andreas Kudera | Report spam
Hallo zusammen,

ich bekomme jeden Monat eine Exceldatei in der nur in der Spalte "A"
Inhalte stehen.
Die Daten sind in Blöcke aufgeteilt. Beispiel: Der erste Block steht in
A1:A30, angeführt von einer Überschrift. Dann kommen zwei Leerzeilen und
der zweite Block beginnt in A33 und geht bis A45 auch angeführt mit
einer Überschrift usw.
Ich möchte nun per Makro die Blöcke ab Block zwei aus der Spalte "A" in
Spalten kopieren. Also Block zwei in Spalte "B" (ab B1), Block 3 in
Spalte "C" (ab C1)usw. Das Makro soll die Spalte "A" solange durchlaufen
, bis alle Blöcke kopiert sind und danach den Inhalt in Spalte "A" ab
Block zwei löschen.
Bisher sind die Blöcke immer mit zwei Leerstellen getrennt, es kann aber
auch mal sein, das es nur eine ist oder evtl. auch mal mehr wie zwei.
Hat mir jemand eine Lösung

Gruß Andy
 

Lesen sie die antworten

#1 Andreas Killer
08/03/2009 - 10:59 | Warnen spam
Andreas Kudera schrieb:

Ich möchte nun per Makro die Blöcke ab Block zwei aus der Spalte "A" in
Spalten kopieren. Also Block zwei in Spalte "B" (ab B1), Block 3 in
Spalte "C" (ab C1)usw. Das Makro soll die Spalte "A" solange durchlaufen
, bis alle Blöcke kopiert sind und danach den Inhalt in Spalte "A" ab
Block zwei löschen.



Sub TransponiereBlockweise()
Dim Ystart As Long, Yende As Long, X As Long

'Suche Ende des ersten Blockes
Ystart = Range("A1").End(xlDown).Row
'Kopiere ab Spalte B
X = 2

'Bildschirm aus
Application.ScreenUpdating = False
Do
'Suche Beginn des 2ten Blockes
Ystart = Range("A" & Ystart).End(xlDown).Row
'Suche Ende des 2ten Blockes
Yende = Range("A" & Ystart).End(xlDown).Row
'Blattende erreicht?
If Yende = Rows.Count Then Exit Do
'Verschiebe Block in nàchte Spalte
Range(Range("A" & Ystart), Range("A" & Yende)).Cut
Cells(1, X).Select
ActiveSheet.Paste
'Nàchste Spalte
X = X + 1
Loop
Application.ScreenUpdating = True
'Kopiermodus aus
Application.CutCopyMode = False
End Sub

Ähnliche fragen