Datenblöcke in Tabelle

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Peter,
"Die Tagesdaten sollen an die bestehende Zieltabelle angefügt werden" - das geht mit Formeln nicht so toll.
Diese nicht ganz unwesentliche Info konnte auch Tino noch nicht berücksichtigen.
In Tinos Mappe habe ich einen zweiten Button eingefügt, der das hier startet: Option Explicit Sub Uebertrage() Dim lngQ As Long, arQ, arZ(), lngZ As Long, zz As Long, qq As Long With Sheets("Ausgangstabelle") lngQ = .Cells(.Rows.Count, 1).End(xlUp).Row lngZ = lngQ / 9 If lngQ lngZ * 9 Then ' Neunerblöcke prüfen MsgBox "Die Zeilenzahl in '" & .Name & "' ist nicht durch 9 teilbar", _ vbCritical, "Abbruch in Uebertrage" Exit Sub End If arQ = .Cells(1, 2).Resize(lngQ) ' Quelldaten in Array End With ReDim arZ(1 To lngZ, 1 To 4) ' Übertrag in Zielarray For zz = 1 To lngZ qq = qq + 1: arZ(zz, 1) = arQ(qq, 1) ' 1 Name qq = qq + 3: arZ(zz, 2) = arQ(qq, 1) ' 4 Nr qq = qq + 1: arZ(zz, 3) = arQ(qq, 1) ' 5 earliest qq = qq + 4: arZ(zz, 4) = arQ(qq, 1) ' 9 Einträge Next zz With Sheets("Zieltabelle") ' Ausgabe zz = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 ' unter letzten Eintrag .Cells(zz, 1).Resize(lngZ, 4) = arZ End With End Sub Die Prozedur kümmert sich überhaupt nicht darum, was in Spalte A der Ausgangsdaten steht.
Hier die Mappe:
https://www.herber.de/bbs/user/90259.xlsm
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich und: Schöne Ostern allerseits!

Sub Auszug() ErsteFreie = ActiveSheet.Cells(1048576, 1).End(xlUp).Row + 1 With Tabelle2 .Range("A" & ErsteFreie & ":A" & .Rows.Count).Resize(, UBound(oDic) + 1).ClearContents For n = LBound(oDic) To UBound(oDic) If oDic(n).Count > 0 Then .Cells(ErsteFreie, n + 1).Resize(oDic(n).Count) = Application.Transpose(oDic(n). _ items) End If Next n End With End Sub

Hallo nochmal,
hatte mich heute nachmittag auch mit dem Thema befasst. war nur zwischendurch mal ne Runde Fahrrad fahren an der Elbe und Grillen:-)
Meine Variante war ne For Next Schleife und das kopieren der Daten nach Zieltabelle. Wenn die Ausgangstabelle nach Auswertung gelöscht wird, sollte das auch ne funktionierende Lösung sein.

Sub copy_Daten()
Dim i As Long
Dim Lz As Long, Lzz1 As Long, Lzz2 As Long, Lzz3 As Long, Lzz4 As Long
Application.ScreenUpdating = False
Lzz1 = Cells(Rows.Count, 1).End(xlUp).Row
Lzz2 = Cells(Rows.Count, 2).End(xlUp).Row
Lzz3 = Cells(Rows.Count, 3).End(xlUp).Row
Lzz4 = Cells(Rows.Count, 4).End(xlUp).Row
With Sheets("Ausgangstabelle")
Lz = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To Lz Step 8
.Cells(i, 2).Copy Destination:=Sheets("Zieltabelle").Cells(Lzz1 + 1, 1)
Lzz1 = Lzz1 + 1
Next
For i = 4 To Lz Step 8
.Cells(i, 2).Copy Destination:=Sheets("Zieltabelle").Cells(Lzz2 + 1, 2)
Lzz2 = Lzz2 + 1
Next
For i = 5 To Lz Step 8
.Cells(i, 2).Copy Destination:=Sheets("Zieltabelle").Cells(Lzz3 + 1, 3)
Lzz3 = Lzz3 + 1
Next
For i = 7 To Lz Step 8
.Cells(i, 2).Copy Destination:=Sheets("Zieltabelle").Cells(Lzz4 + 1, 4)
Lzz4 = Lzz4 + 1
Next
End With
Application.ScreenUpdating = True
End Sub

Frohe Ostern und Grüße aus Dresden
Uwe

Beliebteste Forumthreads (12 Monate)

	A	B	C	D
1	Name	Nr.	Datum	Einträge
2	Paul	1234567	Fri 18Apr14 5:11:41 p.m.	12
3	Hans	987654	Fri 18Apr14 4:55:55 p.m.	3
4

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Datenblöcke in Tabelle

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread