Thema: VBA;Alle Zellen in Spalte A untereinander | Herbers Excel-Forum

Schönen guten Tag,
habe schon einiges recherchiert. Aber folgendes finde ich nicht:
Ein Makro soll mir alle vorhandenen Zellen (ab Spalte B)
in Spalte A kopieren. Alles müßte in Spalte A untereinander stehen.
Vielen Dank
Gruß
Günter

Hallo,
vielleicht hilft dir das:
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
Gruß
welga

Vielen Dank welga.
Probiere...
Schönen Gruß
günter

Hallo welga,
beim Test passiert überhaupt nichts.
Habe eine "sub" draus gemacht, aber ohne Erfolg.

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

Gruß
Günter

Hi Günter,
bei mir funkt es . Hier mal eine Beispieldatei. Oder hatte ich dich falsch verstanden?
https://www.herber.de/bbs/user/66470.xls

Hallo welga,
danke für die Rückmeldung.
Funtioniert jetzt bei mir insofern, dass eine Zeile untereinander
geschrieben wird.
Mein Problem ist, dass alle vorhandenen Zellwerte (egal
wo sie stehen) untereinander in Spalte A geschrieben
werden sollten.
Hier eine Beispieldatei:
https://www.herber.de/bbs/user/66479.xls
Schönen Gruß

Hallo,
alles klar. Dann versuch mal deisen Code:

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

Gruß
welga

Hallo welga,
folgendes passiert beim Ablauf:

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

...bekommt Fehlermeldung bei folgender Zeile mit Laufzeitfehler '91! stehen:
e = .Cells.Find(What:="*", After:=Range("A1"), _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Gruß
Günter

Hallo Günter,
probier mal:

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

Gruß
welga