Daten auf Wochentag aufteilen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub verteilen() Dim Tb1, Tb2, SP%, Anz%, LR1%, LR2%, L1%, I%, J%, Z% '------anpassen----- Set Tb1 = Sheets("Tabelle1") Set Tb2 = Sheets("Tabelle2") SP = 1 'Werte aus Spalte A L1 = 2 ' Eintragen ab Zeile2 Anz = InputBox("Wechsel nach .. Zeilen", , 10) ' Wechsel nach.. LR1 = Tb1.Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte LR2 = Tb2.Cells(Rows.Count, 1).End(xlUp).Row If LR2 <> 1 Then Tb2.Range(Rows(L1), Rows(LR2)).Delete 'Löschen I = 1 Do Until I >= LR1 'UrsprungsZeilenzähler Z = Z + 1 'Spaltenwechsel For J = 1 To Anz Tb2.Cells(J - 1 + L1, Z) = Tb1.Cells(I, SP) I = I + 1 Next J Loop End Sub

Sub verteilen() Dim Tb1, Tb2, SP%, Anz%, LR1%, LR2%, L1%, I%, J%, Z% '------anpassen----- Set Tb1 = Sheets("Tabelle1") Set Tb2 = Sheets("Tabelle2") SP = 1 'Werte aus Spalte A L1 = 2 ' Eintragen ab Zeile2 Anz = InputBox("Wechsel nach .. Zeilen", , 10) ' Wechsel nach.. LR1 = Tb1.Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte LR2 = Tb2.Cells(Rows.Count, 1).End(xlUp).Row If LR2 <> 1 Then Tb2.Range(Tb2.Rows(L1), Tb2.Rows(LR2)).Delete 'Löschen I = 1 Do Until I >= LR1 'UrsprungsZeilenzähler Z = Z + 1 'Spaltenwechsel For J = 1 To Anz Tb2.Cells(J - 1 + L1, Z) = Tb1.Cells(I, SP) I = I + 1 Next J Loop End Sub

Hallo nochmal
Die Wochentage werden jetzt auch noch mit erzeugt.:


Sub verteilen()
Dim Tb1, Tb2, SP%, Anz%, LR1%, Spmax%, L1%, I%, J%, Z%, Tage, R%
'------anpassen-----
Set Tb1 = Sheets("Tabelle1")
Set Tb2 = Sheets("Tabelle2")
SP = 1 'Werte aus Spalte A
L1 = 2 ' Eintragen ab Zeile2
Tage = Array("", "Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag")
Anz = InputBox("Wechsel nach .. Zeilen", , 10) ' Wechsel nach..
LR1 = Tb1.Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
Tb2.Cells.Clear 'Löschen
R = 1
' Wochentage erzeugen
Spmax = WorksheetFunction.RoundUp(LR1 / Anz, 0) 'Anzahl Spalten ermitteln
For I = 1 To Spmax
Cells(1, I) = Tage(R)
R = R + 1: If R > 5 Then R = 1
Next I
I = 1
Do Until I >= LR1 'UrsprungsZeilenzähler
Z = Z + 1 'Spaltenwechsel
For J = 1 To Anz
Tb2.Cells(J - 1 + L1, Z) = Tb1.Cells(I, SP)
I = I + 1
Next J
Loop
Tb2.Select
End Sub

Gruß UweD
(Rückmeldung wäre schön)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten auf Wochentag aufteilen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread