Daten untereinader statt nebeneinander

Hallo!
Habe da mal wieder ein Problem
In den Spalten A bis E stehen folgende Daten:
Name, Vorname, Zeitraum, Stand und Betrag
In den Spalten F und G stehen dann irgendwelche weitere Daten.
Das Ganze über ca. 500 Zeilen (immer versch. Namen)
Sobald in Spalte H in der Zeile einer Person Daten stehen soll unterhalb der Zeile dieser Person:
- eine Leerzeile eingefügt werden
- die Daten aus der darüber liegenden Zeile (Felder A bis E) in diese Leerzeile runterkopiert werden
- die Daten aus Feld H in Feld F der neuen Zeile verschoben werden
Das Ganze soll auch passieren, wenn bei einer Personenzeile in den Felder I bis M Daten stehen.
Also im Prinzip sollen Werte aus den Feldern H bis M einer Person nicht mehr nebeneinander erscheinen sondern untereinander.
Ich hoffe das war irgendwie verständlich.
Wie lässt sich so was machen?
Kann mir jemand helfen?
Danke!!!
Gruß
Werner

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub aaa() Dim lRow As Long, rng As Range, n As Integer Application.ScreenUpdating = False For lRow = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 n = 0 If Application.CountA(Range(Cells(lRow, 8), Cells(lRow, 13))) Then For Each rng In Range(Cells(lRow, 8), Cells(lRow, 13)).SpecialCells(xlCellTypeConstants) n = n + 1 Cells(lRow + n, 1).EntireRow.Insert Range(Cells(lRow, 1), Cells(lRow, 5)).Copy Cells(lRow + n, 1) rng.Cut Cells(lRow + n, 6) Next End If Next End Sub

Also diese Lösung gefällt mir super.
Klappt einwandfrei (soweit ich das überblicken kann).
Ich habe da aber noch was:
Ich habe mehrere Dateien dieser Art.
In Jeder sind ca 800 Datensätze.
Ich möchte das per Makro 250 Datensätze in eine andere Datei (Muster.xls) kopiert werden (nur die Werte ohen Format usw.).
Aber: Das Makro soll nachsehen, ob an der 250. Zeile nicht ggf. der gleiche Name in der Zeile darunter steht.
Also mehrere Zeilen die zu einem Namen gehören sollen auch komplett verschoben und nicht auseinander gerissen werden.
Nach dem kopieren der Zeilen soll gefragt werden, unter welchem Namen die Datei abgespeichert werden soll und die Zeilen sollen danach in der Originaldatei gelöscht werden.
Dann die nächsten 250 Datensätze bis nix mehr da ist.
Gruß
Werner

Sub aa() Dim arrDaten(), arrTmp, i As Long, j As Long, k As Long, n As Long ReDim arrDaten(1 To Cells(Rows.Count, 1).End(xlUp).Row + Application.CountA(Range("H:M")), 1 _ To 13) arrTmp = Cells(1, 1).CurrentRegion For j = 1 To 6 arrDaten(1, j) = arrTmp(1, j) Next n = 1 For i = 2 To UBound(arrTmp) n = n + 1 For j = 1 To 6 arrDaten(n, j) = arrTmp(i, j) Next For k = 8 To 13 If arrTmp(i, k) "" Then n = n + 1 For j = 1 To 5 arrDaten(n, j) = arrTmp(i, j) Next arrDaten(n, 5) = arrTmp(i, k) End If Next k Next i Worksheets.Add.Cells(1, 1).Resize(UBound(arrDaten), 13) = arrDaten End Sub

Beliebteste Forumthreads (12 Monate)

Daten untereinader statt nebeneinander

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten untereinader statt nebeneinander

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread