von Zeilen in Spalten transformieren nach FETT

Hallo zusammen
Ich habe eine grosse Excel-Liste welche wie folgt aussieht:
021 244 97 95
Callcenter unbekannt
Postfach 200101
021 317 55 55
Link Marketing
021 334 57 77
Callcenter unbekannt
021 343 24 91
MIS Trend SA, Lausanne
Schweiz
021 508 70 06
Prämien Scout AG, kostenloser Prämienvergleich
Die einzelnen Datensätze beginnen jeweils mit einen Fett markierten Eintrag, dann folgenden 1 - 3 Zeilen von Text welche zum Datensatz gehöhren. Der neue Datensatz beginnt wieder mit einem fetten Eintrag.
Ich müsste nun die Zeilen zwischen den fetten Einträgen in einzelne Spalten kopieren, so dass die Datensätze anschliessend als CSV exportiert werden können.
Leider bin ich ein VBA Anfänger und habe wenig Wissen wie ich dies konkreit in Marco umsetzen kann.
Hat jemand eine Idee?
Danke und Gruss
MTH

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
in ein Modul und aus der Tabelle starten:

Sub Trans()
Dim rngA As Range, rngB As Range, oTrans As Object
Dim maxCols As Integer, arr, i As Integer, j As Integer, arrtmp, arrDaten
Set oTrans = CreateObject("Scripting.dictionary")
Set rngA = Range("A1")  'Startzelle
Set rngB = rngA
Do
Do
Set rngB = rngB.Offset(1)
Loop Until rngB.Offset(1).Font.Bold Or rngB.Offset(1) = ""
oTrans(oTrans.Count) = WorksheetFunction.Transpose(Range(rngA, rngB))
maxCols = WorksheetFunction.Max(maxCols, Range(rngA, rngB).Rows.Count)
Set rngA = rngB.Offset(1)
Set rngB = rngA
Loop Until rngA = ""
arr = oTrans.items
ReDim arrDaten(1 To oTrans.Count, 1 To maxCols)
For i = 0 To UBound(arr)
arrtmp = arr(i)
For j = LBound(arrtmp) To UBound(arrtmp)
arrDaten(i + 1, j) = arrtmp(j)
Next
Next
Sheets(2).Cells(1, 1).Resize(oTrans.Count, maxCols) = arrDaten
End Sub

Gruß
Rudi

Sub fettTrans() Dim Bereich As Range Dim Fett As Range Dim AdresseZeile As Integer Dim AdresseSpalte As Integer Dim iVerschieber As Integer With ActiveSheet.Range("A1:A13") For Each Fett In ActiveSheet.Range("A1:A13") If Fett.Font.Bold = True Then iVerschieber = 0 AdresseZeile = Fett.Row AdresseSpalte = Fett.Column Else iVerschieber = iVerschieber + 1 .Cells(AdresseZeile, AdresseSpalte + iVerschieber).Value = Fett.Value End If Next End With End Sub

Beliebteste Forumthreads (12 Monate)

von Zeilen in Spalten transformieren nach FETT

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

316 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

von Zeilen in Spalten transformieren nach FETT

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

316 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread