Daten von Zeilen in Spalten kopieren

Hallo zusammen,
ich habe das Problem, eine größere Datenmenge in ein von mir nutzbares Format zu bringen.
Die Daten sind alle einer Spalte, sollten aber untereinander in mehreren Spalten stehen.
Beispiel vorhandene Daten:
1.
Dat1
Dat2
Dat3
....
2.
Dat4
....
Die Datensätze sind durch eine Zahl mit Punkt getrennt (nicht fortlaufend, manche Zahlen sind doppelt vergeben).
Ich möchte jetzt die nächsten 4 Zeilen die auf eine Zahl mit Punkt folgen, in einer eigenen Spalte haben. Das ganze wäre mit kopieren und transponieren, nätürlich problemlos machbar. Es sind aber mehrere tausend Datensätze, sprich, es wäre eine äußerst stupide Arbeit.
Ich hoffe mal, dass mir jemand weiterhelfen kann, da ich von VBA null Ahnung habe.
Gruß Thomas

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Thomas,
vorausgesetzt die Daten in den anderen Zeilen erfüllen immer die Bedingung (nie gleichzeitug enden mit einem Punkt und beginnen mit einer Ziffer), dann funktioniert folgendes Makro. Diese Makro in ein Modul im VBA-Editor einfügen. Fall noch kein Modul vorhanden, dann im VBA-Projekt-Explorer Datei markieren, rechter Mausklick, Einfügen, Modul. ggf. die Namen der Tabellen im Makro an die Namen in der Arbeitsmappe anpassen.
mfg
Franz


Option Explicit
Sub DatenTransponieren()
Dim wks1 As Worksheet, wks2 As Worksheet, text As Variant
Dim Zeile1 As Long, Zeile2 As Long, I As Integer
Set wks1 = ActiveWorkbook.Sheets("Tabelle1") 'Quelltabelle mit Daten in einer Spalte
Set wks2 = ActiveWorkbook.Sheets("Tabelle2") 'Zieltabelle mit Daten in 4 Spalten
Zeile1 = 1
Zeile2 = 2
With wks2
.Range(.Rows(2), .Rows(.Rows.Count)).ClearContents 'Daten in Zieltabelle ab Zeile 2 löschen
End With
Do Until Zeile1 > wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row
text = wks1.Cells(Zeile1, 1)
If Right(text, 1) = "." Then
Select Case Left(text, 1)
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
Zeile1 = Zeile1 + 1
For I = 1 To 4
wks2.Cells(Zeile2, I) = wks1.Cells(Zeile1, 1)
Zeile1 = Zeile1 + 1
Next I
Zeile2 = Zeile2 + 1
Case Else
Zeile1 = Zeile1 + 1
End Select
Else
Zeile1 = Zeile1 + 1
End If
Loop
End Sub

Beliebteste Forumthreads (12 Monate)

Daten von Zeilen in Spalten kopieren

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten von Zeilen in Spalten kopieren

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread