Zeilen in Spalten ändern

Hallo zusammen,
ich habe leider ein Problem mit Adressdaten:
Beim Import erstellt mir Excel folgendes Datenblatt:
1 Frau
3 Muster Muster
4 46537 Dinslaken
5 Testweg 12
1 Frau
3 Muster Muster
4 47178 Duisburg
5 Teststr. 12
1 Eheleute
3 Muster Muster
4 46535 Dinslaken
5 Feldstr.
7 Muster Muster
Jedoch möchte ich die Daten für einen Serienbrief nicht in einer Spalte untereinander haben sondern das er mir alle Zeilen in Spalten umwirft - Wenn ich transponiere habe ich zwar alle Zeilen in Spalten ich möchte aber, dass er mir z.B. die Anrede, den Namen und die Straße in einer Spalte untereinander bringt.
Also unter 1 alle Anreden unter 3 den Namen unter 4 den Ort und unter 5 die Str. etc.
Ich hoffe, ich habe mich deutlich ausgedrückt und freue mich auf die Antworten und vielen Dank schonmal vorab
Hoeffi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub xZeilenInSpalten() Anzfelder = 4 Count0 = ActiveCell.Row Do Until Count0 = ActiveSheet.UsedRange.Rows.Count For Count1 = 1 To Anzfelder - 1 acr = ActiveCell.Row acc = ActiveCell.Column If Empty = Cells(acr + 1, acc).Value Then Else Cells(acr, acc + Count1).Value = Cells(acr + 1, acc).Value Cells(acr + 1, 1).EntireRow.Delete End If Next Count1 Cells(acr + 1, acc).Select Count0 = acr Loop End Sub

jetz sollte es funktionieren


Sub xZeilenInSpalten()
Cells(1, 4).Select
Anzfelder = 4
Count0 = ActiveCell.Row
Do Until Count0 = ActiveSheet.UsedRange.Rows.Count
For Count1 = 1 To Anzfelder - 1
acr = ActiveCell.Row
acc = ActiveCell.Column
If Empty = Cells(acr + 1, acc).Value Then
Else
Cells(acr, acc + Count1).Value = Cells(acr + 1, acc).Value
Cells(acr + 1, 1).EntireRow.Delete
End If
If Cells(acr + 1, acc - 1).Value = 7 Then
Cells(acr, acc + Count1 + 1).Value = Cells(acr + 1, acc).Value
Cells(acr + 1, 1).EntireRow.Delete
End If
Next Count1
Cells(acr + 1, acc).Select
Count0 = acr
Loop
Cells(1, 3).EntireColumn.Delete
End Sub

cu mealone

Sub inSpalten() Dim i As Integer, z As Integer, Spalte As Integer z = 1 For i = 1 To Cells(65536, 4).End(xlUp).Row If Cells(i, 2) <> "" Then z = z + 1 End If Spalte = Cells(i, 3) Sheets(2).Cells(z, Spalte) = Cells(i, 4) Next i End Sub

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeilen in Spalten ändern

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread