[flinx]

Versuchs mit:

Sub umreihen()
Dim i, j, k, l As Integer
i = 3
j = 1
k = 3
l = 9
Application.ScreenUpdating = False
While ActiveWorkbook.Sheets(1).Cells(i, j).Value <> ""

ActiveWorkbook.Sheets(1).Cells(k, l).Value = ActiveWorkbook.Sheets(1).Cells(i, j).Value
ActiveWorkbook.Sheets(1).Cells(k, l + 1).Value = ActiveWorkbook.Sheets(1).Cells(i, j + 1).Value
ActiveWorkbook.Sheets(1).Cells(k, l + 2).Value = ActiveWorkbook.Sheets(1).Cells(i, j + 2).Value
k = k + 1
ActiveWorkbook.Sheets(1).Cells(k, l).Value = ActiveWorkbook.Sheets(1).Cells(i, j + 4).Value
ActiveWorkbook.Sheets(1).Cells(k, l + 1).Value = ActiveWorkbook.Sheets(1).Cells(i, j + 5).Value
ActiveWorkbook.Sheets(1).Cells(k, l + 2).Value = ActiveWorkbook.Sheets(1).Cells(i, j + 6).Value
k = k + 1
i = i + 1
ActiveWorkbook.Sheets(1).Cells(k, l).Value = ActiveWorkbook.Sheets(1).Cells(i, j + 4).Value
ActiveWorkbook.Sheets(1).Cells(k, l + 1).Value = ActiveWorkbook.Sheets(1).Cells(i, j + 5).Value
ActiveWorkbook.Sheets(1).Cells(k, l + 2).Value = ActiveWorkbook.Sheets(1).Cells(i, j + 6).Value
k = k + 1
ActiveWorkbook.Sheets(1).Cells(k, l).Value = ActiveWorkbook.Sheets(1).Cells(i, j).Value
ActiveWorkbook.Sheets(1).Cells(k, l + 1).Value = ActiveWorkbook.Sheets(1).Cells(i, j + 1).Value
ActiveWorkbook.Sheets(1).Cells(k, l + 2).Value = ActiveWorkbook.Sheets(1).Cells(i, j + 2).Value
k = k + 1

i = i + 1
Wend
Application.ScreenUpdating = True
End Sub

Ohne Gewähr!