Spalte auslesen und in anderes Blatt transportiere

Hi,
ich glaube ich habe eine eher einfache Frage, komme aber so nicht voran.
Ich werde regelmäßig einige Ergebnisse in ein Tabellenblatt kopieren müssen.
Das schaut dann so aus, dass die Spalte A, in die ich kopiere, verschiedene Längen annimmt und alles enthält. Jedes Ergebnis ist durch eine Zahl kenntlich gemacht (manchmal ist aber eine Leerzeile drunter).
D.h. ein Ausschnitt könnte so aussehen:
45
Ergebniselement1
Ergebniselement2
...
Ergebniselement7
46
Leerzeile manchmal
Ergebniselement1
Ergebniselement2
...
Ergebniselement7
= also werden Sie durch eine Zahl getrennt.
Wüsste jemand hier, wie ich besagte Ergebnisse am besten auslesen kann und dann in ein anderes Blatt ebenfalls in Spalte A bestenfalls mit einer Zeile pro Ergebnis kopiert bekomme ?
Vielen Dank schonmal im Voraus...

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Ramona,
unter der ANnahme das dein Tabellenblatt exakt so aussieht, das heisst die "Blocküberschriften" sind aufsteigend fortlaufende Zahlen und alles dazwischen ist Text, dann so (erste Zahl steht in Zeile 2 -- falls nicht, bitte im Makro ändern):

Option Explicit
Const TabAus As String = "Tabelle1"  'Blattname
Const TabZu As String = "Tabelle2"   'Blattname
Const SpalteX As Long = 1            'Spalte A
Sub AlleUeberfuehren()
Application.ScreenUpdating = False
Call RumKopieren(2) 'Erste Zahl steht in Zeile 2
Application.ScreenUpdating = True
End Sub
Sub RumKopieren(ZeileAb As Long)
Dim myZahl As Long
Dim ZeileBis As Long
Dim ZeileIn As Long
Dim doAgain As Boolean
doAgain = True
With Sheets(TabZu)
ZeileIn = .Cells(.Rows.Count, SpalteX).End(xlUp).Row + 1
End With
With Sheets(TabAus)
myZahl = .Cells(ZeileAb, SpalteX).Value
On Error GoTo hell:
ZeileBis = WorksheetFunction.Match(myZahl + 1, .Columns(SpalteX), False) - 1
GoTo heaven:
hell:
ZeileBis = .Cells(.Rows.Count, SpalteX).End(xlUp).Row
doAgain = False
heaven:
On Error GoTo 0
.Range(.Cells(ZeileAb, SpalteX), .Cells(ZeileBis, SpalteX)).Copy
Sheets(TabZu).Cells(ZeileIn, SpalteX).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
End With
If doAgain Then RumKopieren (ZeileBis + 1)
End Sub

Grüße,
Klaus M.vdT.

Beliebteste Forumthreads (12 Monate)

Spalte auslesen und in anderes Blatt transportiere

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spalte auslesen und in anderes Blatt transportiere

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread