Option Explicit
Sub Zeitauslesung()
Dim LastRowName As Integer
Dim i As Integer
Dim B As Integer
Dim D As Integer
Dim LastRowSort As Integer
Dim Datum As Date
LastRowName = Tabelle2.Range("A" & Rows.Count).End(xlUp).Row
For B = 2 To LastRowName
LastRowSort = Sheets(B + 10).Range("A" & Rows.Count).End(xlUp).Row
D = 2
For i = 2 To LastRowSort
Datum = Sheets(B + 10).Cells(i, 2).Value
Debug.Print "Date"
If Not Weekday(Datum, vbMonday) = 6 And Not Weekday(Datum, vbMonday) = 7 And Not Datum = Sheets(2).Cells(2, 5).Value And Not Datum = Sheets(2).Cells(3, 5).Value And Not Datum = Sheets(2).Cells(4, 5).Value And Not Datum = Sheets(2).Cells(5, 5).Value And Not Datum = Sheets(2).Cells(6, 5).Value And Not Datum = Sheets(2).Cells(7, 5).Value And Not Datum = Sheets(2).Cells(8, 5).Value And Not Datum = Sheets(2).Cells(9, 5).Value And Not Datum = Sheets(2).Cells(10, 5).Value And Not Datum = Sheets(2).Cells(11, 5).Value And Not Datum = Sheets(2).Cells(12, 5).Value And Not Datum = Sheets(2).Cells(13, 5).Value And Not Datum = Sheets(2).Cells(14, 5).Value Then
Sheets(B + 10).Range(Cells(i, 1), Cells(i, 11)).Copy Sheets(B + 10).Cells(D, 13)
D = D + 1
End If
Next i
Next B
MsgBox "Ausgeführt"
End Sub