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
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).
20.03.2015, 11:17 (Dieser Beitrag wurde zuletzt bearbeitet: 20.03.2015, 12:00 von 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
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
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.