HERBERS Excel-Forum - das Archiv
VBA;Alle Zellen in Spalte A untereinander
Günter

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

AW: VBA;Alle Zellen in Spalte A untereinander
welga

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
AW: VBA;Alle Zellen in Spalte A untereinander
Günter

Vielen Dank welga.
Probiere...
Schönen Gruß
günter
AW: VBA;Alle Zellen in Spalte A untereinander
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
AW: VBA;Alle Zellen in Spalte A untereinander
welga

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
AW: VBA;Alle Zellen in Spalte A untereinander
Günter

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ß
AW: VBA;Alle Zellen in Spalte A untereinander
welga

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
AW: VBA;Alle Zellen in Spalte A untereinander
Günter

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
AW: VBA;Alle Zellen in Spalte A untereinander
welga

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