Office: (Office 365) VBA Auslesen von Strings und erstellen neuer Zeilen in einer Tabelle

Guten Tag zusammen
In der 1. Spalte stehen KundenIDs (jeweils 2 Buchstaben), separiert mit einem Komma.
Beispielsweise:
ag,ok,be,li,ce

In der 2. bis 15. Spalte stehen dann diverse Eigenschaften, die alle diese Kunden in Spalte 1 betreffen.
Dieses Format brauche ich, damit ich das File in einem System uploaden konnte.

Insgesamt habe ich ca. 70 bis 80 verschiedene Zeilen dieser Art.

Nun möchte ich jedoch pro Kunde und Eigenschaft eine eigene Zeile kreiieren.
Das heisst, für die 1. Zeile mit den Kunden ag,ok,be,li,ce sollen insgesamt 5 Zeilen entstehen (der Kunde in Spalte 1, die Eigenschaften nach wie vor in Spalte 2 bis 15).

Dies würde ich gerne in einer neuen Tabelle niederschreiben.

Ich kann natürlich zuerst paar Spalten einfügen (Daten - Text in Spalten) und dann würde ich es wohl hinbekommen mit einem VBA Code, aber dies scheint mir umständlich zu sein.

Es ist übrigens so, dass in der 1. Spalte ab und zu 2 Kunden, ab und zu 10 Kunden stehen, von dem her ist die Anzahl generierter Zeilen auch unterschiedlich.


Kann mir jemand einen Tipp geben mit VBA?

bisher:
ag,ok,be,li,ce II Mainz II Bananen II ...
ok,be II Hamburg II Bananen II

neu:
ag II Mainz II Bananen
ok II Mainz II Bananen
be II Mainz II Bananen
li II Mainz II Bananen
ce II Mainz II Bananen
ok II Hamburg II Bananen
be II Hamburg II Bananen

ich hoffe, ihr versteht was ich meine.
Danke vielmals für eure Unterstützung

 

habs nun mal so gelöst dass ich zuerst Text in Spalten mache; anschliessend nochmals eine leere Spalte einfüge und dann:

Sub neueListe()
zeile_neu = 2
For zeile = 2 To 72
n = 1
Do While Cells(zeile, n) <> ""
sID = Cells(zeile, n)
Range("AC" & zeile_neu) = sID
Range("N" & zeile & ":AA" & zeile).Copy Destination:=Range("AD" & zeile_neu)
zeile_neu = zeile_neu + 1
n = n + 1
Loop
Next

End Sub

 

Hi,

das geht auch ohne dass man erst Text in Spalten ausführt - und zwar so:

Code:

Sub Trennen()
    Dim lngZeile As Long
    Dim lngAnzahl As Long
    Dim arrA
    Dim arrBP()
    For lngZeile = Columns(1).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row To 2 Step -1
        arrA = Split(Cells(lngZeile, 1), ",")
        arrBP = Range(Cells(lngZeile, 2), Cells(lngZeile, 16))
        lngAnzahl = UBound(arrA)
        Range(Cells(lngZeile, 1), Cells(lngZeile + lngAnzahl - 1, 1)).EntireRow.Insert
        Cells(lngZeile, 1).Resize(UBound(arrA) + 1, 1) = Application.Transpose(arrA)
        Range(Cells(lngZeile, 2), Cells(lngZeile + lngAnzahl - 1, 16)) = arrBP
    Next lngZeile
End Sub

---