Transponieren

Option Explicit
Sub transponieren()
' Klaus-Dieter Oppermann Mai 2005
' Variablen deklarieren
Dim arre As Variant                             ' Array Ausgangsdaten
Dim arra() As Variant                           ' Array transponierte Daten
Dim s As Integer                                ' Schleifenzähler
Dim ss As Integer                               ' Schleifenzähler Ausgangsdaten
Dim az As Integer                               ' Schleifenzähler 1. Arrayfeld transponierte Daten
Dim sp As Integer                               ' Schleifenzähler 2. Arrayfeld transponierte Daten
' Daten einlesen
arre = Selection                                ' markierten Bereich in Array
ReDim arra(UBound(arre) / 7, 8)                 ' Dimension an Liste anpassen
' transponieren
For s = LBound(arre) To UBound(arre) / 7        ' "äußere" Schleife
    For sp = 0 To 6                             ' "innere" Schleife (Arrayfelder)
        ss = ss + 1                             ' Zähler plus 1
        arra(az, sp) = arre(ss, 1)              ' Array mit transponierten Daten füllen
    Next sp                                     ' Schleifenzähler plus 1
    If ss Mod 7 = 0 Then az = az + 1            ' wenn "Zeile" im Array gefüllt, dann Feldzähler plus 1
Next s                                          ' Schleifenzähler plus 1
Range("C3", "J" & UBound(arre) / 7 + 3) = arra  ' transponierte Daten in Tabelle schreiben
' Liste formatieren
With Columns("C:I")                             ' Bereich definieren
    .WrapText = False                           ' kein Zeilenumbruch
    .EntireColumn.AutoFit                       ' optimale Spaltenbreite
End With                                        ' Ende der Definition
End Sub