Suchen, Auswählen, Merken, Drucken

[Alex105]

:100: danke Schauan

Schönen Abend noch :15:

Gruss,
Alex

[schauan]

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..

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

[Alex105]

Guten Abend Schauan

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

[schauan]

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))

[Alex105]

Hallo Schauan,

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

[schauan]

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

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

[Alex105]

: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

[Alex105]

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

[Alex105]

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

[Alex105]

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