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
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen