Zeilen untereinander in eine Spalte transponieren

Forumthread: Zeilen untereinander in eine Spalte transponieren

21.02.2025 11:28:59

Andre Hernandez

Guten Morgen,

ich bin leider totaler Neuling im Bereich VBA-Programmierung und stehe vor dem Problem, einen großen Datenberg transponieren zu müssen.

Es geht darum, dass Materialstammsätze von einer Spalten- in eine Zeilenstruktur gebracht werden müssen. Entgegen der Standardtransponierfunktion sollen die Zeilen aber fortlaufend untereinander und nicht nebeneinander angeordnet werden. Die Kopfzeile (=Eigenschaftsbezeichnung 1 2 3) muss immer mit transponiert werden und wiederholt sich so in Spalte A immer wieder bis zum Ende der Tabelle.

ABC
123
456
789

nach

AB
14
25
36
17
28
39

Die Anzahl der Eigenschaften (=Ursprungsspalten) kann hierbei variieren. Idealerweise prüft das Makro also immer die Zelle rechts neben einer gefüllten Zelle, ob diese leer ist und wenn ja, endet der zu transponierende Bereich. Oder man legt die Anzahl der Spalten halt im Makro fest. Ich müsste dann nur schauen, wo und wie :)
Das Makro sollte erkennen, wenn es bei der letzten mit Daten gefüllten Zeile der Ursprungstabelle angekommen ist und dann enden.

Ich hoffe, ich konnte mich einigermaßen verständlich ausdrücken. Anbei zur besseren Verdeutlichung eine Beispieldatei.

https://www.herber.de/bbs/user/175905.xlsx

Ich würde mich wirklich sehr freuen, wenn mir jemand helfen könnte.

Vielen Dank und beste Grüße
André

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zeilen untereinander in eine Spalte transponieren

21.02.2025 12:46:49

UweD

Hallo

meinst du das so

Sub Trans()

    Dim Tb1 As Worksheet, Tb2 As Worksheet, LR1 As Long, LR2 As Long, LC As Integer, I As Long

    

    Set Tb1 = Sheets("Tabelle1") 'Quelle

    Set Tb2 = Sheets("Tabelle2") 'Ziel

    

    LR1 = Tb1.Cells(Tb1.Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte A

    LC = Tb1.Cells(1, Tb1.Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile

    

    

    'Reset

    Tb2.UsedRange.Delete

    

    Application.ScreenUpdating = False

    

    With Tb2

        For I = 2 To LR1

            LR2 = IIf(.Cells(1, 1) = "", 1, Tb2.Cells(Tb2.Rows.Count, 1).End(xlUp).Row + 1) 'erste freie Zeile

            

            'Kopf

            Tb1.Cells(1, 1).Resize(1, LC).Copy

            .Cells(LR2, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True

            

            'Daten

            Tb1.Cells(I, 1).Resize(1, LC).Copy

            .Cells(LR2, 2).PasteSpecial Paste:=xlPasteAll, Transpose:=True

            

        Next

    End With

    Application.CutCopyMode = False ' Kopiermodus deaktivieren

    

    MsgBox "Fertig"

End Sub

LG UweD

AW: Zeilen untereinander in eine Spalte transponieren

21.02.2025 13:18:13

André

Hallo Uwe,

das Makro macht auf den ersten Blick genau was es soll! Vielen Dank für deine Mühe!!

Ich werde es mit unterschiedlichen Tabellenkonstellationen testen und mich dann noch mal melden.

Vielen Dank nochmal und ein schönes Wochenende
André

Zeilen untereinander in eine Spalte transponieren

Forumthread: Zeilen untereinander in eine Spalte transponieren

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Zeilen untereinander in eine Spalte transponieren

Forumthread: Zeilen untereinander in eine Spalte transponieren

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

Forumthreads zu verwandten Themen

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread