Daten Sortieren in Spalten und Zeilen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Onur,
ja genau. Ich möchte gerne auf Tabellenblatt2 einfach alle Tage von jeder Person untereinanderschreiben. Für jede Person ein Blatt wird tatsächlich nicht gehen, da es im Originaldatensatz sehr viele sind. Mein vba-code kann sie bisher nur die Tage in Spalten sortieren, aber nicht die Tage jeweils für eine Person untereinander:
ub DatenSortieren()
Worksheets("Tabelle2").Range("B1:XFD97").ClearContents
Dim Zeile As Long
Dim Spalte As Long
Dim i As Long
Dim Anzahl As Long
Dim j As Long
Spalte = 1
For i = 2 To Worksheets("Tabelle1").UsedRange.Rows.Count
Zeit = TimeSerial(Int(Cells(i, 4) / 100), Cells(i, 4) - (Int(Cells(i, 4) / 100) * 100), 0)
If Cells(i, 3) Cells(i - 1, 3) Then
Spalte = Spalte + 1
Worksheets("Tabelle2").Cells(1, Spalte) = Worksheets("Tabelle1").Cells(i, 1) 'Kopiert haushaltsID
Worksheets("Tabelle2").Cells(2, Spalte) = Worksheets("Tabelle1").Cells(i, 3) ' Kopiert DatumsID
End If
Zeile = 3 + (Int(Cells(i, 4) / 100) * 4) + (Int(Cells(i, 4) - (Int(Cells(i, 4) / 100) * 100)) / 15)
Debug.Print Zeile
Worksheets("Tabelle2").Cells(Zeile, Spalte) = (Worksheets("Tabelle1").Cells(i, 5))
Next i
Worksheets("Tabelle2").Activate
End Sub
Kannst du mir hier vielleicht nochmals weiterhelfen?
Grüße,
Julia

Hallo,
ich habe eine Makro Lösung, bin mir aber nach der letzten Rückfrage von Onur nicht mehr so sicher ob meine Lösung richtig ist? Am besten zuerst in einer Beispieldatei testen, damit nicht versehentlich Originaldaten überschrieben werden.
mfg Piet


Option Explicit    '31.1.2017   Piet   Herber Forum
Sub Daten_kopieren()
Dim rFind As Object
Worksheets("Tabelle1").Select
'alle LastZellen abwaerts ermitteln
lz = Cells(Rows.Count, "B").End(xlUp).Row + 1
lz2 = Range("C4").End(xlDown).Row
lz3 = Range("D4").End(xlDown).Row
Set rFind = Columns(1).Find(What:="00:00 - 00:15", After:=Range("A6"), _
LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
If rFind Is Nothing Then GoTo Fehler
'Spalte C kopieren
Range("C4:C" & lz2).Copy 'oder Cut nehmen
rFind.Offset(0, 1).PasteSpecial xlPasteAll
'neue LastZelle Spalte B ermitteln
Set rFind = Columns(1).FindNext(After:=Range(rFind.Address))
If rFind Is Nothing Then GoTo Fehler
'Spalte D kopieren
Range("D4:D" & lz3).Copy 'oder Cut nehmen
rFind.Offset(0, 1).PasteSpecial xlPasteAll
Application.CutCopyMode = False
Exit Sub
Fehler: MsgBox "Kann Uhrzeit '00:00 - 00:15' nicht finden"
End Sub

Beliebteste Forumthreads (12 Monate)

Daten Sortieren in Spalten und Zeilen

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

332 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten Sortieren in Spalten und Zeilen

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

332 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread