Zellbezug bis leere Zeile

[ich121212]

Hallo,

Stehe vor folgender Problemstellung.
Habe große Datensätze die durch eine leerzeile,bzw. in der ersten Spalte steht ein Text, getrennt sind.
Also in der Form;
A         B       C
Neust.
1        3       0
5        8       1
6        5       0
7        4       2
Neust.
1        3       0
5        8       1
6        5       0
7        4       2
.....usw.
Ich möchte diese Datenblöcke die untereinander stehen in Spalten aufteilen.
in der Form
A B C D E F
1 3 0 1 3 0
5 8 1 5 8 1
6 5 0 6 5 0 .............
Im Endeffekt möchte ich ein vorgefertigtes File haben, dass mir die eingefügten Daten(aus Txt.) automatisch umformatiert.
Die Daten aus dem Txt.-File sind in diesem Format:
Neust.
1,3,0
5,8,1
6,5,0
Neust.
usw.....

Die zusammengehörigen Datensätze haben immer unterschiedliche Länge(zwischen 500 und 2000 Zeilen) und die Anzahl der Datenblöcke(10-50) variiert auch.
Wenns geht ohne VBA, wenn nicht auch kein Problem.

Hoffe ihr könnt mir helfen, hab leider keine Idee zur Lösung des Problems und auch nicht nichts wirklich nützliches gefunden.

Beste Grüße
Roman

[EbyAS]

Guten Morgen,
also ohne VBA habe ich keine Hoffnung aber ohne ein Beispiel-Sheet rühre ich keinen Finger.

[ich121212]

Danke für die schnelle Antwort.
Hab ein Beispiel sheet angehängt, hoffe es ist verständlich
Danke für die Hilfe im Voraus
lg Roman

[EbyAS]

Hallo,
ich habe die Daten in die Tabelle1 kopiert.

[ich121212]

Danke!
Und wo finde ich diese?

[Kuwer]

Hallo Roman,

folgendes Makro sollte es tun:

Sub Makro1()
  Dim lngArea As Long
  Application.ScreenUpdating = False
  'Range("A1").CurrentRegion.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
      Semicolon:=False, Comma:=True, Space:=False, Other:=False
  With Range("A1").CurrentRegion
    .Columns(2).SpecialCells(xlCellTypeBlanks).Offset(, -1) = ""
    For lngArea = 2 To .SpecialCells(xlCellTypeConstants).Areas.Count
      .SpecialCells(xlCellTypeConstants).Areas(1).Copy Cells(5, Application.Max(6, Cells(5, Columns.Count).End(xlToLeft).Column + 1))
      .SpecialCells(xlCellTypeConstants).Areas(lngArea).Copy Cells(6, Application.Max(6, Cells(6, Columns.Count).End(xlToLeft).Column + 1))
    Next lngArea
  End With
  Application.ScreenUpdating = True
End Sub

Gruß Uwe

[ich121212]

Danke Uwe für die Mühe.
Hab erst ein bisschen angefangen mit VBA zu arbeiten und nicht wirklich einen Plan gehabt wie ich das schreiben soll.

funktioniert perfekt, nochmals danke!