Sub test()
Dim i As Long
Dim a As Long
With ThisWorkbook.Sheets(1)
a = .Cells(1, 256).End(xlToLeft).Columns
For i = 2 To a
.Cells(i, 1).Value = .Cells(1, i).Value
Application.Cells(1, i).ClearContents
Next i
End With
End Sub
Sub test()
Dim i As Long
Dim a As Long
Dim e As Integer
Dim ii As Integer
Dim iii As Integer
iii = 0
With ThisWorkbook.Sheets(1)
e = .Cells.Find(What:="*", After:=Range("A1"), _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For ii = 1 To e
a = .Cells(ii, Columns.Count).End(xlToLeft).Column
For i = 2 To a
If Cells(ii, i).Value "" Then
iii = iii + 1
.Cells(iii, 1).Value = .Cells(ii, i).Value
Application.Cells(ii, i).ClearContents
End If
Next i
Next ii
End With
End Sub
Sub Marken_untereinander()
Dim i As Long
Dim a As Long
Dim e As Integer
Dim ii As Integer
Dim iii As Integer
iii = 0
With ThisWorkbook.Sheets(1)
e = .Cells.Find(What:="*", After:=Range("A1"), _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For ii = 1 To e
a = .Cells(ii, Columns.Count).End(xlToLeft).Column
For i = 2 To a
If Cells(ii, i).Value "" Then
iii = iii + 1
.Cells(iii, 1).Value = .Cells(ii, i).Value
Application.Cells(ii, i).ClearContents
End If
Next i
Next ii
End With
End Sub
Sub Marken_untereinander()
Dim i As Long
Dim a As Long
Dim e As Integer
Dim ii As Integer
Dim iii As Integer
iii = 0
With ThisWorkbook.Sheets(1)
.UsedRange.Select
e = Selection.Cells.SpecialCells(xlLastCell).Row
For ii = 1 To e
a = .Cells(ii, Columns.Count).End(xlToLeft).Column
For i = 2 To a
If Cells(ii, i).Value "" Then
iii = iii + 1
.Cells(iii, 1).Value = .Cells(ii, i).Value
Application.Cells(ii, i).ClearContents
End If
Next i
Next ii
End With
End Sub