Nachmal Stundenplan übertragen

Sub Verteil3()
Dim strZ, ii As Long, tt As Long, datD As Date
strZ = Split("B3 F3 B20 F20")             ' Beginne der Zielbereiche
For tt = 1 To 7                           ' Schleife über 7 Tage=Zielblätter
datD = Sheets("Ausgang").Cells(1, tt + 2)
With Sheets(Format(datD, "yyyy-mm-dd"))
.Cells(1, 1) = datD
For ii = 0 To 3                     ' Schleife über 4 Gruppen
With .Range(strZ(ii)).Resize(4)
.Value = Sheets("Ausgang").Cells(ii * 4 + 2, 1).Resize(4).Value
.Offset(, 1) = Sheets("Ausgang").Cells(ii * 4 + 2, tt + 2).Resize(4).Value
End With
Next ii
End With
Next tt
End Sub