Spalten Dynamisch untereinander einfügen mit VBA

[SemmyW]

Hallo zusammen,

kurz zur Info, ich bin ein Anfänger in VBA und beherrsche die meisten Sachen nur durch das Aufzeichnen von Makros. Dynamisches VBA programmieren ist bei mir noch etwas entfernt.

Ich habe es geschafft einige Daten aus einer Umfangreichen Tabelle in einen neuen Reiter nebeneinander zu fügen.
Ich muss wohl im nächsten Schritt eine gewisse Dynamic im VBA Code verwenden, um alle Daten untereinander in Spalte A zu bekommen.

Anbei könnt Ihr den Datensatz (Alle Namen wurden durch Zahlen ersetzt) finden um den es geht. Im Reiter "SOLL" könnt Ihr das Format sehen in das ich die Daten benötige.

Wenn die Daten alle untereinander stehen, sollte ich den Rest selber schaffen.


Vielen Dank schon mal für eure Hilfe!

Beste Grüße

[Mase]

Mahlzeit Sammy,

ein Vorschlag:

Code:

Const m_sZiel As String = "IST"

Sub TransposeYtoX()
    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim rng As Range, rngUsedRange As Range
    Dim lngLastRow As Long, lngLastCol As Long, i As Long
    Dim arr() As Variant
    '
    On Error GoTo err
    '
    Set wkb = ThisWorkbook
    Set wks = wkb.Worksheets(m_sZiel)
    Set rngUsedRange = wks.UsedRange
    '
    With wks
        lngLastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For i = 2 To lngLastCol Step 1
            Set rng = rngUsedRange.Columns(i).Cells
            Let arr = rng
            Let lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            Let .Cells(lngLastRow, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
        Next i
    End With
    '
err:
If err.Number <> 0 Then
    MsgBox err.Number & vbCrLf & err.Description
End If
'
Erase arr
Set rngUsedRange = Nothing: Set rng = Nothing
Set wks = Nothing: Set wkb = Nothing
End Sub

[SemmyW]

Mahlzeit Sammy,

ein Vorschlag:

Code:

Const m_sZiel As String = "IST"

Sub TransposeYtoX()
    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim rng As Range, rngUsedRange As Range
    Dim lngLastRow As Long, lngLastCol As Long, i As Long
    Dim arr() As Variant
    '
    On Error GoTo err
    '
    Set wkb = ThisWorkbook
    Set wks = wkb.Worksheets(m_sZiel)
    Set rngUsedRange = wks.UsedRange
    '
    With wks
        lngLastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For i = 2 To lngLastCol Step 1
            Set rng = rngUsedRange.Columns(i).Cells
            Let arr = rng
            Let lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            Let .Cells(lngLastRow, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
        Next i
    End With
    '
err:
If err.Number <> 0 Then
    MsgBox err.Number & vbCrLf & err.Description
End If
'
Erase arr
Set rngUsedRange = Nothing: Set rng = Nothing
Set wks = Nothing: Set wkb = Nothing
End Sub

Vielen Dank!
Das hat ja gleich super geklappt.

Bis ich das kann dauert es wohl noch ein wenig.
Magst du mir die wichtigsten Zeilen des Makros kurz erklären?


Speziell was machen die 3 Codes?
Const m_sZiel As String = "IST"
____
.
.
.
____
Function getLastRow(wks As Worksheet) As Long

End Function
____
Function getLastCol(wks As Worksheet) As Long

End Function



Auf jeden Fall schon mal Danke!
Hat mich weiter gebracht. Jetzt muss ich das nur noch in meinen bestehenden VBA Code einfügen. :15:

[Mase]

Hi,

freut mich, dass es Dich weiterbringt.

Code:

Function getLastRow(wks As Worksheet) As Long

End Function
____
Function getLastCol(wks As Worksheet) As Long

End Function

Hier wollte ich das Ermitteln der letzten Spalte bzw letzten Zeile für Dich in eine Funktion auslagern, da Du das zukünftig (wahrscheinlich) immer wieder brauchst.
Hatte mich im Verlauf aber dagegen entschieden und nicht wieder entfernt. Kannste ignorieren.

Code:

Const m_sZiel As String = "IST"

Hier wird der Arbeitsblattname als Konstante des Datentyps Strings definiert.
Natürlich ginge es auch mit einer Variablen des Datentyps String.

Die erstgenannte Variante läuft schneller durch als die Zweitgenannte.

[SemmyW]

Hi,

freut mich, dass es Dich weiterbringt.

Code:

Function getLastRow(wks As Worksheet) As Long

End Function
____
Function getLastCol(wks As Worksheet) As Long

End Function

Hier wollte ich das Ermitteln der letzten Spalte bzw letzten Zeile für Dich in eine Funktion auslagern, da Du das zukünftig (wahrscheinlich) immer wieder brauchst.
Hatte mich im Verlauf aber dagegen entschieden und nicht wieder entfernt. Kannste ignorieren.

Code:

Const m_sZiel As String = "IST"

Hier wird der Arbeitsblattname als Konstante des Datentyps Strings definiert.
Natürlich ginge es auch mit einer Variablen des Datentyps String.

Die erstgenannte Variante läuft schneller durch als die Zweitgenannte.

Danke sehr!