Zelle kopieren nach 3 Bedingungen

[Excelsius]

Guten Tag zusammen,

ich möchte die Begriffe aus Spalte1 von "Wartungsarbeiten" in die Tabelle von Sheet4 kopieren. Dabei müssen 3 Bedingungen behandelt werden. Ich kriege es nicht hin, dass nur die erste Spalte kopiert wird. Die Datei nimmt die 1. Spalte und spammt die Reihen durch bis XDF. Woran liegt das?




Hab dazu folgenden Code erstellt:
Code:

Code:

Sub Kopieren()

Dim Zeile As Long
Dim ZeileMax As Long
Dim n As Long

With Tabelle1
ZeileMax = .UsedRange.Rows.Count
n = 1

For Zeile = 2 To ZeileMax

If .Cells(Zeile, 3).Value = "Wöchentlich" And .Cells(Zeile, 4).Value = "Freitag" And .Cells(Zeile, 5).Value = "Spätschicht" Then

.Cells(Zeile,1).Copy Destination:=Tabelle5.Rows(n)
n = n + 1


End If
Next Zeile
End With
End Sub

mit freundlichen Grüßen

[Der Steuerfuzzi]

Code:

.Cells(Zeile,1).Copy Destination:=Tabelle5.Rows(n)

Mit Rows nimmst Du die ganze Zeile. Du müsstest innerhalb der Zeile oder der Tabelle noch die Zelle bestimmen:

Code:

Tabelle5.Rows(n).Cells(1,1)

oder kürzer:

Code:

Tabelle5.Cells(n, 1)

Du musst die Werte nicht über Copy einfügen. Es reicht auch so:

Code:

Tabelle5.Cells(n, 1).value = .Cells(Zeile,1).value

[Excelsius]

Danke es funktioniert! :19:  

Hab es jetzt auf folgenden Code ausgebaut, jedoch werden die Zellen nicht in den angegebenen Zellen abgespeichert.. das wird immer ohne Sinn verschoben.:/

Code:

Sub Kopieren()

Dim Zeile As Long
Dim ZeileMax As Long
Dim n As Long

With Tabelle1
ZeileMax = .UsedRange.Rows.Count
n = 1

For Zeile = 2 To ZeileMax

If .Cells(Zeile, 3).Value = "Wöchentlich" And .Cells(Zeile, 4).Value = "Freitag" And .Cells(Zeile, 5).Value = "Spätschicht" Then

Tabelle4.Rows(n).Cells(36, 10).Value = .Cells(Zeile, 1).Value
n = n + 1
End If

If .Cells(Zeile, 3).Value = "Wöchentlich" And .Cells(Zeile, 4).Value = "Donnerstag" And .Cells(Zeile, 5).Value = "Spätschicht" Then

Tabelle4.Rows(n).Cells(34, 8).Value = .Cells(Zeile, 1).Value
n = n + 1

End If

If .Cells(Zeile, 3).Value = "Wöchentlich" And .Cells(Zeile, 4).Value = "Mittwoch" And .Cells(Zeile, 5).Value = "Spätschicht" Then

Tabelle4.Rows(n).Cells(34, 6).Value = .Cells(Zeile, 1).Value
n = n + 1

End If

If .Cells(Zeile, 3).Value = "Wöchentlich" And .Cells(Zeile, 4).Value = "Dienstag" And .Cells(Zeile, 5).Value = "Spätschicht" Then

Tabelle4.Rows(n).Cells(34, 4).Value = .Cells(Zeile, 1).Value
n = n + 1

End If

If .Cells(Zeile, 3).Value = "Wöchentlich" And .Cells(Zeile, 4).Value = "Montag" And .Cells(Zeile, 5).Value = "Spätschicht" Then

Tabelle4.Rows(n).Cells(34, 2).Value = .Cells(Zeile, 1).Value
n = n + 1

End If

If .Cells(Zeile, 3).Value = "Wöchentlich" And .Cells(Zeile, 4).Value = "Montag" And .Cells(Zeile, 5).Value = "Frühschicht" Then

Tabelle4.Rows(n).Cells(8, 2).Value = .Cells(Zeile, 1).Value
n = n + 1
End If

If .Cells(Zeile, 3).Value = "Wöchentlich" And .Cells(Zeile, 4).Value = "Dienstag" And .Cells(Zeile, 5).Value = "Frühschicht" Then

Tabelle4.Rows(n).Cells(8, 4).Value = .Cells(Zeile, 1).Value
n = n + 1
End If

If .Cells(Zeile, 3).Value = "Wöchentlich" And .Cells(Zeile, 4).Value = "Mittwoch" And .Cells(Zeile, 5).Value = "Frühschicht" Then

Tabelle4.Rows(n).Cells(8, 6).Value = .Cells(Zeile, 1).Value
n = n + 1
End If

If .Cells(Zeile, 3).Value = "Wöchentlich" And .Cells(Zeile, 4).Value = "Donnerstag" And .Cells(Zeile, 5).Value = "Frühschicht" Then

Tabelle4.Rows(n).Cells(8, 8).Value = .Cells(Zeile, 1).Value
n = n + 1
End If

If .Cells(Zeile, 3).Value = "Wöchentlich" And .Cells(Zeile, 4).Value = "Freitag" And .Cells(Zeile, 5).Value = "Frühschicht" Then

Tabelle4.Rows(n).Cells(8, 10).Value = .Cells(Zeile, 1).Value
n = n + 1
End If

If .Cells(Zeile, 3).Value = "Täglich" Then
Tabelle4.Rows(n).Cells(20, 2).Value = .Cells(Zeile, 1).Value
n = n + 1
End If

Next Zeile
End With
End Sub

Mir fällt grad aber etwsa auf:


Glaub der übernimmt die Anordnung aus Tabelleblatt1, sodass ein Begriff aus Zeile5 nicht in Cells(8,2) wie angegeben angespeichert wird, sondern in Cells (12,2) (halt um 5 verschoben).

Wie krieg ich die Verschiebung weg?

[BoskoBiati]

Hallo,

1. UsedRange ist eine gefährliche Angelegenheit, da wäre es besser die letzte gefüllte Zelle in A zu wählen.
2. das n brauchst Du für jede Spalte separat!
3. das .Value kannst Du auch weglassen.

Ich würde das Makro so aufbauen, habe es aber nicht getestet:

Code:

Sub Kopieren()


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 loTFMo As Long
Dim loTFDi As Long
Dim loTFMi As Long
Dim loTFDo As Long
Dim loTFFr As Long
Dim loTSMo As Long
Dim loTSDi As Long
Dim loTSMi As Long
Dim loTSDo As Long
Dim loTSFr As Long

 loWFMo = 8
 loWFDi = 8
 loWFMi = 8
 loWFDo = 8
 loWFFr = 8
 loWSMo = 36
 loWSDi = 36
 loWSMi = 36
 loWSDo = 36
 loWSFr = 36
 loTFMo = 20
 loTFDi = 20
 loTFMi = 20
 loTFDo = 20
 loTFFr = 20
 loTSMo = 48
 loTSDi = 48
 loTSMi = 48
 loTSDo = 48
 loTSFr = 48
 
With Tabelle1
ZeileMax = Cells(Rows.Count, 1).End(xlUp).Row
n = 1

For Zeile = 2 To ZeileMax
Set Rng = .Cells(Zeile, 1)
    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, 2) = Rng
                        loWSDi = loWSDi + 1
                    Case "Mittwoch"
                        Cells(loWSMi, 2) = Rng
                        loWSMi = loWSMi + 1
                    Case "Donnerstag"
                        Cells(loWSDo, 2) = Rng
                        loWSDo = loWSDo + 1
                    Case "Freitag"
                        Cells(loWSFr, 2) = 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, 2) = Rng
                        loWFDi = loWFDi + 1
                    Case "Mittwoch"
                        Cells(loWFMi, 2) = Rng
                        loWFMi = loWFMi + 1
                    Case "Donnerstag"
                        Cells(loWFDo, 2) = Rng
                        loWFDo = loWFDo + 1
                    Case "Freitag"
                        Cells(loWFFr, 2) = Rng
                        loWFFr = loWFFr + 1
                End Select
            End If
        Else
             If .Cells(Zeile, 5) = "Spätschicht" Then
                Select Case .Cells(Zeile, 4)
                    Case "Montag"
                        Cells(loTSMo, 2) = Rng
                        loTSMo = loTSMo + 1
                    Case "Dienstag"
                        Cells(loTSDi, 2) = Rng
                        loTSDi = loTSDi + 1
                    Case "Mittwoch"
                        Cells(loTSMi, 2) = Rng
                        loTSMi = loTSMi + 1
                    Case "Donnerstag"
                        Cells(loTSDo, 2) = Rng
                        loTSDo = loTSDo + 1
                    Case "Freitag"
                        Cells(loTSFr, 2) = Rng
                        loTSFr = loTSFr + 1
                End Select
            Else
                Select Case .Cells(Zeile, 4)
                    Case "Montag"
                        Cells(loTFMo, 2) = Rng
                        loTFMo = loTFMo + 1
                    Case "Dienstag"
                        Cells(loTFDi, 2) = Rng
                        loTFDi = loTFDi + 1
                    Case "Mittwoch"
                        Cells(loTFMi, 2) = Rng
                        loTFMi = loTFMi + 1
                    Case "Donnerstag"
                        Cells(loTFDo, 2) = Rng
                        loTFDo = loTFDo + 1
                    Case "Freitag"
                        Cells(loTFFr, 2) = Rng
                        loTFFr = loTFFr + 1
                End Select
            End If
        End If
Next Zeile
End With
End Sub

[Excelsius]

Schonmal vielen Dank Edgar!

Ich musste nur die Spaltennummern anpassen dann lief das alles. Nur bei den TäglichenAufgaben spuckt der nichts aus :/

[BoskoBiati]

Hallo,

ich habe es gerade überarbeitet, weil man da doch einiges sparen kann:

Code:

Sub Kopieren()



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 = 8
 loWFDi = 8
 loWFMi = 8
 loWFDo = 8
 loWFFr = 8
 loWSMo = 36
 loWSDi = 36
 loWSMi = 36
 loWSDo = 36
 loWSFr = 36
 loTF = 20
 loTS = 48
 
With Tabelle1
ZeileMax = .Cells(Rows.Count, 1).End(xlUp).Row
n = 1

For Zeile = 2 To ZeileMax
Set Rng = .Cells(Zeile, 1)
    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

[Excelsius]

Musste noch die Tabelle "Erledigt" (->"Tabelle1", unter der eigentlichen Tabelle)hinzuführen. Deshalb löscht mir dein neuer Code ein par Zeilen aus.
Dein Code ist super so wie er war, nur ich kriege es nicht hin, dass er mir alle "Täglich" Spalten ausfüllt.
Für Erledigt hab ich einfach den selben Code genommen, nur dass er mir jetzt in Wartungsarbeiten!Spalte2 nach der Tätigkeit sucht.

Um das "Täglich"-Problem zu lösen, hab ich einfach die Cases z.Bsp. "Montag" in "" umgewandelt, da diese Felder in Wartungsarbeiten!Spalte3-5 ja auch nicht ausgefüllt sind, das klappt jedoch auch nicht.. nach wie vor werden die "Täglich"-Aufgaben nur in Spalte B im passenden Abschnitt abgespeichert. Sollte man das umsetzen können wäre die Tabelle so, wie ich sie mir vorgestellt habe.:)

Code:

With Tabelle1
ZeileMax = Cells(Rows.Count, 1).End(xlUp).Row
n = 1

For Zeile = 2 To ZeileMax
Set Rng = .Cells(Zeile, 1)
   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
            If .Cells(Zeile, 5) = "" Then
               Select Case .Cells(Zeile, 4)
                   Case ""
                       Cells(loTSMo, 2) = Rng
                       loTSMo = loTSMo + 1
                   Case ""
                       Cells(loTSDi, 4) = Rng
                       loTSDi = loTSDi + 1
                   Case ""
                       Cells(loTSMi, 6) = Rng
                       loTSMi = loTSMi + 1
                   Case ""
                       Cells(loTSDo, 8) = Rng
                       loTSDo = loTSDo + 1
                   Case ""
                       Cells(loTSFr, 10) = Rng
                       loTSFr = loTSFr + 1
               End Select
           Else
               If .Cells(Zeile, 5) = "" Then
               Select Case .Cells(Zeile, 4)
                   Case ""
                       Cells(loTSMo, 2) = Rng
                       loTSMo = loTSMo + 1
                   Case ""
                       Cells(loTSDi, 4) = Rng
                       loTSDi = loTSDi + 1
                   Case ""
                       Cells(loTSMi, 6) = Rng
                       loTSMi = loTSMi + 1
                   Case ""
                       Cells(loTSDo, 8) = Rng
                       loTSDo = loTSDo + 1
                   Case ""
                       Cells(loTSFr, 10) = Rng
                       loTSFr = loTSFr + 1
               End Select
           Else
               Select Case .Cells(Zeile, 4)
                   Case ""
                       Cells(loTFMo, 2) = Rng
                       loTFMo = loTFMo + 1
                   Case ""
                       Cells(loTFDi, 4) = Rng
                       loTFDi = loTFDi + 1
                   Case ""
                       Cells(loTFMi, 6) = Rng
                       loTFMi = loTFMi + 1
                   Case ""
                       Cells(loTFDo, 8) = Rng
                       loTFDo = loTFDo + 1
                   Case ""
                       Cells(loTFFr, 10) = Rng
                       loTFFr = loTFFr + 1
               End Select
       End If
       End If
       End If

Leider kann ich keine Datei hochladen, da diese zu groß geworden ist.

[Rabe]

Hi,

Leider kann ich keine Datei hochladen, da diese zu groß geworden ist.

Du könntest sie in die Dropbox legen und den Link hier veröffentlichen!

[BoskoBiati]

Hallo,

mein geänderter Code sollte eigentlich die Tagesaufgaben sowohl in Früh- als auch in Spätschicht eintragen.

[Excelsius]

Dropbox kann ich hier auf Arbeit leider nicht benutzen.