Excel Spalteninhalt in neue freie Spalte kopieren

Question

Hallo Leute

Ich habe in Spalte A von A1 bis A10 Zahlen dann etliche Leerzeilen
und wieder von A20 bis A30 Zahlen und A60 bis A90 .mit immer wieder Leerzeilen dazwischen und so weiter

Wie kann man mit einem Makro den Anfang bis Ende der Zahlen in einen neue Spalte bringen also A20 bis A30 in neue freie Spalte weiter
A60 bis A90 in neue freie Spalte kopieren/ausschneiden, uns so weiter.

So die gesamte Spalte bis kein Eintrag mehr vorhanden.
Wenn fertig nächste Spalte durchsuchen selbes Spiel.

Wäre vielleicht jemand von den Spezies so nett mir so ein Makro zu schreiben.

Answer 1

Hallo,

ich gehe mal davon aus, dass deine Zahlenreihen in den Spalten immer in Zeile 1 anfangen.
Kopiere das folgende Makro in ein Standard Modul deiner Arbeitsmappe.

Sub spalten()

Dim lngSpalten As Long
Dim arrInhalt As Variant
Dim lngZielspalte As Long
Dim lngZielzeile As Long
Dim wksQuelle As Worksheet
Dim wksZiel As Worksheet
Dim lngZaehler As Long
Dim bZahl As Boolean

'Quell- und Zieltabelle definieren - Namen anpassen
Set wksQuelle = ThisWorkbook.Worksheets("Tabelle1")
Set wksZiel = ThisWorkbook.Worksheets("Tabelle2")

'ggf. vorhandene Inhalte in Zieltabelle löschen
wksZiel.Cells.Clear

'Schleife für Spalten; Anzahl der Spalten wird in Zeile 1 festgestellt
For lngSpalten = 1 To wksQuelle.Cells(1, Columns.Count).End(xlToLeft).Column
'Marker wird auf falsch gesetzt
bZahl = False
'Spalte wird in Array eingelesen
With wksQuelle
arrInhalt = .Range(.Cells(1, lngSpalten), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, lngSpalten))
End With
'eingelesenes Array durchlaufen
For lngZaehler = LBound(arrInhalt) To UBound(arrInhalt)
'prüfen, ob Inhalt Zahl ist
If IsEmpty(arrInhalt(lngZaehler, 1)) = False Then
If bZahl = False Then
bZahl = True 'Marker auf wahr setzen
lngZielspalte = lngZielspalte + 1 'Variable für Zielspalte um 1 erhöhen
lngZielzeile = 0
End If

'Zahl in neues Blatt übertragen, falls Inhalt eine Zahl ist
If bZahl = True Then
lngZielzeile = lngZielzeile + 1
wksZiel.Cells(lngZielzeile, lngZielspalte) = arrInhalt(lngZaehler, 1)
End If
Else
bZahl = False 'ansonsten wird der Marker auf falsch gesetzt
End If

Next lngZaehler

Next lngSpalten

End Sub

Damit werden deine Zahlen aus dem Quellblatt (Tabelle1) in ein neues Blatt (Tabelle2) kopiert. Das zweite Arbeitsblatt muss in der Tabelle vorhanden sein. Die Namen der Arbeitsblätter kannst du entsprechend anpassen.

Gruß

M.O.

Answer 2

Uh das ging aber fix
Funktioniert 1 A .

Vielen Dank

M.O