Zelle kopieren nach 3 Bedingungen

[BoskoBiati]

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!

[Excelsius]

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

[Excelsius]

Ok ich habs hinbekommen, hab was beim anpassen übersehen!

VIelen Dank Edgar!:)

[Excelsius]

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