04.08.2014, 20:48
05.08.2014, 17:27
Hallo Alex,
hier die nächsten Änderungen. Du kannst ggf. die entsprechenden codeteile komplett austauschen - ich habe jetzt nicht extra "<-- hier" dran.
Zuerst auf DieseArbeitsmappe das ...SheetChange..
Dann das cellReset
hier die nächsten Änderungen. Du kannst ggf. die entsprechenden codeteile komplett austauschen - ich habe jetzt nicht extra "<-- hier" dran.
Zuerst auf DieseArbeitsmappe das ...SheetChange..
Code:
For Each zellen In Target
'Mit dem Bereich Spalte C (3) bis M (13)
With Range(Cells(Target.Row, 3), Cells(Target.Row, 13))
'Wenn Inhalt > 0 ist, dann mit ... einfaerben, sonst Farbe rausnehmen
If zellen > 0 Then .Interior.Color = 5296274 Else .Interior.Color = xlNone
'Ende Mit dem Bereich Spalte C (3) bis M (13)
End With
'Ende Schleife ueber alle gewaehlten Zellen
Next
Dann das cellReset
Code:
'Schleife ueber alle Blaetter
For Each blaetter In Worksheets()
'Wenn der Blattname nicht Input und Sales ist, dann
If blaetter.Name <> "Input" And blaetter.Name <> "Sales" Then
'letzte belegte Zelle in Spalte I '<-- ab hier
loLastRow = Cells(Rows.Count, 9).End(xlUp).Row
'Spalte I ab Zeile 3 bereinigen
blaetter.Range("I3:I" & loLastRow).Value = ""
'letzte belegte Zelle in Spalte I
loLastRow = Cells(Rows.Count, 11).End(xlUp).Row
'Spalte I ab Zeile 3 bereinigen
blaetter.Range("K3:K" & loLastRow).Value = "" '<-- bis hier
'Blatt loeschen, wenn ein Bild drauf ist
If blaetter.Pictures.Count > 0 Then blaetter.Delete
'Ende Wenn der Blattname nicht Input und Sales ist, dann
End If
'Ende Schleife ueber alle Blaetter
Next
05.08.2014, 18:11
Guten Abend Schauan
Danke für das Update.
Allerdings kommt nach dem Kopieren in CellReset folgendes
Hab ich was falsch eingefügt?!
Ich glaube ja diesmal nicht aber ich bin mir sicher, du wirst mich eines besseren belehren :15:
Danke und viele Grüße
Alex
Danke für das Update.
Allerdings kommt nach dem Kopieren in CellReset folgendes
Code:
Sub cellReset()
'Variablendeklaration
Dim blaetter As Worksheet
'Schleife ueber alle Blaetter
For Each blaetter In Worksheets()
'Wenn der Blattname nicht Input und Sales ist, dann
If blaetter.Name <> "Input" And blaetter.Name <> "Sales" Then
'letzte belegte Zelle in Spalte I '<-- ab hier
loLastRow = Cells(Rows.Count, 9).End(xlUp).Row
'Spalte I ab Zeile 3 bereinigen
blaetter.Range("I3:I" & loLastRow).Value = ""
'letzte belegte Zelle in Spalte I
loLastRow = Cells(Rows.Count, 11).End(xlUp).Row <-- HIER HIER HIER "Fehler beim Kompilieren" Variable nicht definiert....
'Spalte I ab Zeile 3 bereinigen
blaetter.Range("K3:K" & loLastRow).Value = "" '<-- bis hier
'Blatt loeschen, wenn ein Bild drauf ist
If blaetter.Pictures.Count > 0 Then blaetter.Delete
'Ende Wenn der Blattname nicht Input und Sales ist, dann
End If
'Ende Schleife ueber alle Blaetter
Next
'Blatt INPUT bereinigen
Sheets("Input").Range("N8:N11, P6, B8:B11, B13, B14, A16, B16, N16:P16, S2, T2").Value = ""
'Blatt SALES Spalte G ab G3 bereinigen
Sheets("Sales").Range("G3:G1048576").Value = ""
End Sub
Hab ich was falsch eingefügt?!
Ich glaube ja diesmal nicht aber ich bin mir sicher, du wirst mich eines besseren belehren :15:
Danke und viele Grüße
Alex
05.08.2014, 19:01
Hallo ALex,
da fehlt was
loLastRow = blaetter.Cells(Rows.Count, 11).End(xlUp).Row
und in DieseArbeitsmappe im ..SheetChange... noch diese Änderung:
'Mit dem Bereich Spalte C (3) bis M (13)
With Sh.Range(Sh.Cells(zellen.Row, 3), Sh.Cells(zellen.Row, 13))
da fehlt was
loLastRow = blaetter.Cells(Rows.Count, 11).End(xlUp).Row
und in DieseArbeitsmappe im ..SheetChange... noch diese Änderung:
'Mit dem Bereich Spalte C (3) bis M (13)
With Sh.Range(Sh.Cells(zellen.Row, 3), Sh.Cells(zellen.Row, 13))
05.08.2014, 19:16
Hallo Schauan,
da steht immernoch bei loLastRow "Variable nicht definiert".
Hier nochmal der Code im Ganzen:
Sag mir bitte nicht, dass schon wieder der Wurm drin ist :20: :25:
Viele Grüße und vielen Dank
Alex
da steht immernoch bei loLastRow "Variable nicht definiert".
Hier nochmal der Code im Ganzen:
Code:
Sub cellReset()
'Variablendeklaration
Dim blaetter As Worksheet
'Schleife ueber alle Blaetter
For Each blaetter In Worksheets()
'Wenn der Blattname nicht Input und Sales ist, dann
If blaetter.Name <> "Input" And blaetter.Name <> "Sales" Then
'letzte belegte Zelle in Spalte I '<-- ab hier
loLastRow = blaetter.Cells(Rows.Count, 11).End(xlUp).Row
'Spalte I ab Zeile 3 bereinigen
blaetter.Range("I3:I" & loLastRow).Value = ""
'letzte belegte Zelle in Spalte I
loLastRow = Cells(Rows.Count, 11).End(xlUp).Row
'Spalte I ab Zeile 3 bereinigen
blaetter.Range("K3:K" & loLastRow).Value = "" '<-- bis hier
'Blatt loeschen, wenn ein Bild drauf ist
If blaetter.Pictures.Count > 0 Then blaetter.Delete
'Ende Wenn der Blattname nicht Input und Sales ist, dann
End If
'Ende Schleife ueber alle Blaetter
Next
'Blatt INPUT bereinigen
Sheets("Input").Range("N8:N11, P6, B8:B11, B13, B14, A16, B16, N16:P16, S2, T2").Value = ""
'Blatt SALES Spalte G ab G3 bereinigen
Sheets("Sales").Range("G3:G1048576").Value = ""
End Sub
Sag mir bitte nicht, dass schon wieder der Wurm drin ist :20: :25:
Viele Grüße und vielen Dank
Alex
05.08.2014, 19:33
Hallo ALex,
nö, ist kein wurm drin. Ich muss nur besser bei den verschiedenen Versionen aufpassen, welche ich zuletzt bearbeitet habe
Hier nochmal der komplette code
nö, ist kein wurm drin. Ich muss nur besser bei den verschiedenen Versionen aufpassen, welche ich zuletzt bearbeitet habe
Hier nochmal der komplette code
Code:
Sub cellReset()
'Variablendeklaration
Dim blaetter As Worksheet
Dim loLastRow As Long
'Schleife ueber alle Blaetter
For Each blaetter In Worksheets()
'Wenn der Blattname nicht Input und Sales ist, dann
If blaetter.Name <> "Input" And blaetter.Name <> "Sales" Then
'letzte belegte Zelle in Spalte I
loLastRow = blaetter.Cells(Rows.Count, 9).End(xlUp).Row
'Spalte I ab Zeile 3 bereinigen
blaetter.Range("I3:I" & loLastRow).Value = ""
'letzte belegte Zelle in Spalte K
loLastRow = blaetter.Cells(Rows.Count, 11).End(xlUp).Row
'Spalte I ab Zeile 3 bereinigen
blaetter.Range("K3:K" & loLastRow).Value = ""
'Blatt loeschen, wenn ein Bild drauf ist
If blaetter.Pictures.Count > 0 Then blaetter.Delete
'Ende Wenn der Blattname nicht Input und Sales ist, dann
End If
'Ende Schleife ueber alle Blaetter
Next
'Blatt INPUT bereinigen
Sheets("Input").Range("N8:N11, P6, B8:B11, B13, B14, A16, B16, N16:P16, S2, T2").Value = ""
'Blatt SALES Spalte G ab G3 bereinigen
Sheets("Sales").Range("G3:G1048576").Value = ""
End Sub
05.08.2014, 19:36
:100: Schauan, das hat geklappt
ABER:
Jetzt nimmer er mir wieder die Überschriften in "I" und "K" weg
ich schmeiß mich weg :79:
Vielen Dank und viele Grüße
Alex
ABER:
Jetzt nimmer er mir wieder die Überschriften in "I" und "K" weg
ich schmeiß mich weg :79:
Vielen Dank und viele Grüße
Alex
05.08.2014, 19:45
EDIT:
Ich hab es in den Fehlenden Zellen mal händisch eingefügt und alles nacheinander abgespielt. Farbein scheint er in den Zellen wieder zu behalten und die "I" & "K" Namen auch.
Ich check das mal für einen Artikel aus jedem Tabellenblatt und gebe dir gern eine Rückmeldung
Bis gleich mal und Danke schön
Viele Grüße
Alex
Ich hab es in den Fehlenden Zellen mal händisch eingefügt und alles nacheinander abgespielt. Farbein scheint er in den Zellen wieder zu behalten und die "I" & "K" Namen auch.
Ich check das mal für einen Artikel aus jedem Tabellenblatt und gebe dir gern eine Rückmeldung
Bis gleich mal und Danke schön
Viele Grüße
Alex
05.08.2014, 19:51
EDIT II:
Also, er nimmt mir tatsächlich die "I" & "K" weg :(
Sorry Schauan:20:
Vielen Dank für die Korrektur vorab!
Viele Grüße
Alex
Also, er nimmt mir tatsächlich die "I" & "K" weg :(
Sorry Schauan:20:
Vielen Dank für die Korrektur vorab!
Viele Grüße
Alex
05.08.2014, 19:53
EDIT III:
Und die Farben aus den Zwischenzellen, die mir die Artikel abgrenzen sollen.
Wir rocken das schon :15: <-- ich bin der rechte
Gruß
Alex
Und die Farben aus den Zwischenzellen, die mir die Artikel abgrenzen sollen.
Wir rocken das schon :15: <-- ich bin der rechte
Gruß
Alex