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
|