Hallo,
entsprechend deiner Beispieltabelle habe ich dir mal ein Makro geschrieben, dass die Übersicht der einzelnen Wochentage in die Drucktabelle überträgt. Beachte aber, dass die Bereich, die kopiert fix sind und ggf. angepasst werden müssen.
Sub uebersicht_erstellen()
Dim ezeile As Long
Dim arrTage
arrTage = Array("Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag")
'ggf Inhalt der Druckübersicht löschen
ezeile = Worksheets("Druckübersicht").Cells(Rows.Count, 3).End(xlUp).Row
If ezeile > 1 Then
With ThisWorkbook.Sheets("Druckübersicht")
.Range(.Cells(1, 1), .Cells(ezeile, .UsedRange.SpecialCells(xlCellTypeLastCell).Column)).EntireRow.Delete xlShiftUp
End With
End If
'Montag bis Donnerstag
For i = 0 To 3
ezeile = Worksheets("Druckübersicht").Cells(Rows.Count, 3).End(xlUp).Row
If i > 0 Then ezeile = ezeile + 2
'Kopieren und Werte mit Formatierungen einfügen
ThisWorkbook.Worksheets(arrTage(i)).Range("B4:AE18").Copy
With ThisWorkbook.Sheets("Druckübersicht").Cells(ezeile, 1)
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
'Zeile mit Zeiten formatieren
With ThisWorkbook.Sheets("Druckübersicht").Range(Cells(ezeile + 3, 5), Cells(ezeile + 3, 30))
.Orientation = -90
.RowHeight = 63.75
End With
Next i
'Freitag
ezeile = Worksheets("Druckübersicht").Cells(Rows.Count, 3).End(xlUp).Row
If i > 0 Then ezeile = ezeile + 2
ThisWorkbook.Worksheets(arrTage(4)).Range("B7:AE21").Copy
With ThisWorkbook.Sheets("Druckübersicht").Cells(ezeile, 1)
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
With ThisWorkbook.Sheets("Druckübersicht").Range(Cells(ezeile + 3, 5), Cells(ezeile + 3, 30))
.Orientation = -90
.RowHeight = 63.75
End With
End Sub
Der Code gehört in ein allgemeines Modul.
Gruß
M.O.
