Hallo Zusammen,

leider habe ich schon wieder ein problem bei dem ich nicht weiter weis.

Bei dem Versuch über eine If und For-Schleife die Range zu kopieren tritt bei mir immer ein Laufzeitfeher (1004) auf jedoch, wird der Code korrekt ausgeführt (zumindest scheint es mir so).

Hier der Link der Angeboten wurde (Microsoft): https://docs.microsoft.com/de-de/office/vba/Language/Reference/User-Interface-Help/application-defined-or-object-defined-error

Zuvor wurden die Zellen alle einzeln kopiert, jedoch verlangsamt das den Prozess erheblich, wehalb ich das gerne ändern würde.

Der Code ist nicht sonderlich hübsch - Bin gerade erst noch am Anfang der Lernkurve

PS.: Es wäre wahrscheinlich eh besser wenn ich es über ein Array angehen würde - Nicht wahr?

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