Zeilen nur übertragen wenn,...
Bowl
Sub Abteilung1_Aktualisieren ()
Dim i, x, v, y, c As Integer, sh As Worksheet
i = 10
For Each sh In ThisWorkbook.Worksheets
If IsNumeric(sh.Name) Then
If sh.Cells(13, 17) = 0 Then
GoTo MARKE1
Else:
Worksheets("A_Saegen").Unprotect
Worksheets("A_Saegen").Cells(i, 2) = sh.Name
Worksheets("A_Saegen").Cells(i, 3) = sh.Range("B4")
For x = 3 To 15
If Sheets(sh.Name).Cells(13, x).Value "" And Sheets(sh.Name).Cells(9, x). _
Value >= Sheets(sh.Name).Cells(2, 17).Value Then
y = Sheets(sh.Name).Cells(13, x).Value
v = Sheets(sh.Name).Cells(9, x).Value
For c = 4 To 13
If Sheets("A_saegen").Cells(9, c).Value = v Then
Sheets("A_saegen").Cells(i, c).Value = y
End If
Next c
End If
Next x
Worksheets("A_saegen").Protect
End If
i = i + 1
End If
MARKE1:
Next sh
End Sub
Ich hab mehrere Tabellenblätter X1,... die nach und nach angelegt werden.
In Zeile 9 stehen Werte für Kalenderwochen, die Werte in Zeile 13 sollen dann in das Blatt von Abteilung A übertragen werden und den entsprechenden Kalenderwochen auch in Zeile 9 (hier aber durch Formel Kalenderwoche()...) eingetragen werden.
Als erstes wird der Name/wert aus zelle B3 in blatt x in die spalte B in blatt 1 übertragen, in spalte c der wert aus C3 von blatt x. die Übertragung soll logischerweise nur dann geschehen, wenn die abteilung in irgendeiner woche mit dem Projekt zu tun hat (also in irgendeiner zelle in zeile 13 blatt x werte stehen; dazu werden die werde zusammengezählt und in Q13 Blatt X stehen die Summen --> Übertragung wenn Summe > 0
Soweit funktioniert das ganze Perfekt:
Jetzt habe ich folgendes Problem:
Falls Werte ausschliesslich in der Vergangenen KW stehen ist eine Übertragung ja sinnlos; Werte werden auch nicht übertragen, allerdings sind die zellen in B und C noch immer gefüllt.
Wie schaff ich es, vor der Übertragung zu kontrollieren ob überhaupt Werte in den Spalten mit kommenden KW stehen?
Versuche das ganze durch den teil
And Sheets(sh.Name).Cells(9, x).Value >= Sheets(sh.Name).Cells(2, 17).Value
also wenn der wert (KW in Spalte 9 größer oder gleich dem wert in (2,17) ist (hier steht immer die aktuelle KW folgt die übertragung...
Versuch des ganze jetzt so, aber so klappt noch weniger
Sub Akutalisieren_Saegen()
Sheets("A_Saegen").Unprotect
Sheets("A_Saegen").Range("A10:P68").ClearContents
Dim i, x, v, y, c As Integer, sh As Worksheet
i = 10
For Each sh In ThisWorkbook.Worksheets
If IsNumeric(sh.Name) Then
If sh.Cells(13, 17) = 0 Then
GoTo MARKE1
Else:
For x = 3 To 15
If Sheets(sh.Name).Cells(13, x).Value = "" Or Sheets(sh.Name).Cells(9, x). _
Value >= Sheets(sh.Name).Cells(2, 17).Value Then
GoTo MARKE2
Else:
Worksheets("A_Saegen").Unprotect
Worksheets("A_Saegen").Cells(i, 2) = sh.Name
Worksheets("A_Saegen").Cells(i, 3) = sh.Range("B4")
y = Sheets(sh.Name).Cells(13, x).Value
v = Sheets(sh.Name).Cells(9, x).Value
For c = 4 To 13
If Sheets("A_saegen").Cells(9, c).Value = v Then
Sheets("A_saegen").Cells(i, c).Value = y
End If
Next c
End If
Next x
MARKE2:
Worksheets("A_saegen").Protect
End If
i = i + 1
End If
MARKE1:
Next sh
End Sub
Irgendjemand nen Tipp, wäre sehr dankbar :)
Anzeige
