Hallo,
wenn Du ins Internet kannst, dann solltest Du auch Dateien von Deinem Rechner in die Dropbox hochladen können!
Dateiupload bitte im Forum! So geht es: Klick mich!
Ok, Du hast natürlich Recht :19: Hab den Code für die Tabelle "Erledigt" mal abgeändert, aber nur damit die Zeilen passen und damit er in Wartungsarbeiten!Spalte2 nach dem Begriff sucht.
An rot markierter Stelle zeigt er mir jedoch einen Fehler auf "Anwendungs- oder objekt definierter Fehler".
Code:
Sub KopierenErledigtNeu()
Dim Zeile As Long
Dim ZeileMax As Long
Dim loWFMo As Long
Dim loWFDi As Long
Dim loWFMi As Long
Dim loWFDo As Long
Dim loWFFr As Long
Dim loWSMo As Long
Dim loWSDi As Long
Dim loWSMi As Long
Dim loWSDo As Long
Dim loWSFr As Long
Dim loTF As Long
Dim loTS As Long
Dim loSpalte As Long
loWFMo = 90
loWFDi = 90
loWFMi = 90
loWFDo = 90
loWFFr = 90
loWSMo = 129
loWSDi = 129
loWSMi = 129
loWSDo = 129
loWSFr = 129
loTFMo = 107
loTSMo = 146
With Tabelle1
ZeileMax = .Cells(Rows.Count, 1).End(xlUp).Row
n = 1
For Zeile = 2 To ZeileMax
Set Rng = .Cells(Zeile, 2)
If .Cells(Zeile, 3) = "Wöchentlich" Then
If .Cells(Zeile, 5) = "Spätschicht" Then
Select Case .Cells(Zeile, 4)
Case "Montag"
Cells(loWSMo, 2) = Rng
loWSMo = loWSMo + 1
Case "Dienstag"
Cells(loWSDi, 4) = Rng
loWSDi = loWSDi + 1
Case "Mittwoch"
Cells(loWSMi, 6) = Rng
loWSMi = loWSMi + 1
Case "Donnerstag"
Cells(loWSDo, 8) = Rng
loWSDo = loWSDo + 1
Case "Freitag"
Cells(loWSFr, 10) = Rng
loWSFr = loWSFr + 1
End Select
Else
Select Case .Cells(Zeile, 4)
Case "Montag"
Cells(loWFMo, 2) = Rng
loWFMo = loWFMo + 1
Case "Dienstag"
Cells(loWFDi, 4) = Rng
loWFDi = loWFDi + 1
Case "Mittwoch"
Cells(loWFMi, 6) = Rng
loWFMi = loWFMi + 1
Case "Donnerstag"
Cells(loWFDo, 8) = Rng
loWFDo = loWFDo + 1
Case "Freitag"
Cells(loWFFr, 10) = Rng
loWFFr = loWFFr + 1
End Select
End If
Else
For loSpalte = 2 To 10 Step 2
[color=#ff3366]Cells(loTF, loSpalte) = Rng[/color]
Cells(loTS, loSpalte) = Rng
Next
loTF = loTF + 1
loTS = loTS + 1
End If
Next Zeile
End With
End Sub
Ok im Code sieht man es anscheinend nicht.. hier nochmal extern:
For loSpalte = 2 To 10 Step 2
Cells(loTF, loSpalte) = Rng
Cells(loTS, loSpalte) = Rng
Next
loTF = loTF + 1
loTS = loTS + 1
Ok ich habs hinbekommen, hab was beim anpassen übersehen!
VIelen Dank Edgar!:)
Wenn ich das Programm bzw Tabelle um "Monatlich" erweitern will.. wie pass ich da die If-Else-Anweisung an? Denn bei mir schreibt der die Sachen dann an die passende Stellen ( Dim loM As Long; loM = 168) aber zusätzlich kopiert der mir die Tätigkeiten auch zu den Täglichen Aufgaben :/
Code:
Sub KopierenErledigtNeu()
Dim Zeile As Long
Dim ZeileMax As Long
Dim loWFMo As Long
Dim loWFDi As Long
Dim loWFMi As Long
Dim loWFDo As Long
Dim loWFFr As Long
Dim loWSMo As Long
Dim loWSDi As Long
Dim loWSMi As Long
Dim loWSDo As Long
Dim loWSFr As Long
Dim loTF As Long
Dim loTS As Long
Dim loM As Long
Dim loSpalte As Long
loWFMo = 90
loWFDi = 90
loWFMi = 90
loWFDo = 90
loWFFr = 90
loWSMo = 129
loWSDi = 129
loWSMi = 129
loWSDo = 129
loWSFr = 129
loTF = 107
loTS = 146
loM = 168
With Tabelle1
ZeileMax = .Cells(Rows.Count, 1).End(xlUp).Row
n = 1
For Zeile = 2 To ZeileMax
Set Rng = .Cells(Zeile, 2)
If .Cells(Zeile, 3) = "Wöchentlich" Then
If .Cells(Zeile, 5) = "Spätschicht" Then
Select Case .Cells(Zeile, 4)
Case "Montag"
Cells(loWSMo, 2) = Rng
loWSMo = loWSMo + 1
Case "Dienstag"
Cells(loWSDi, 4) = Rng
loWSDi = loWSDi + 1
Case "Mittwoch"
Cells(loWSMi, 6) = Rng
loWSMi = loWSMi + 1
Case "Donnerstag"
Cells(loWSDo, 8) = Rng
loWSDo = loWSDo + 1
Case "Freitag"
Cells(loWSFr, 10) = Rng
loWSFr = loWSFr + 1
End Select
Else
Select Case .Cells(Zeile, 4)
Case "Montag"
Cells(loWFMo, 2) = Rng
loWFMo = loWFMo + 1
Case "Dienstag"
Cells(loWFDi, 4) = Rng
loWFDi = loWFDi + 1
Case "Mittwoch"
Cells(loWFMi, 6) = Rng
loWFMi = loWFMi + 1
Case "Donnerstag"
Cells(loWFDo, 8) = Rng
loWFDo = loWFDo + 1
Case "Freitag"
Cells(loWFFr, 10) = Rng
loWFFr = loWFFr + 1
End Select
End If
Else
For loSpalte = 2 To 10 Step 2
Cells(loTF, loSpalte) = Rng
Cells(loTS, loSpalte) = Rng
Next
loTF = loTF + 1
loTS = loTS + 1
End If
Next Zeile
End With
End Sub