Einzelnes Sheet in einer Arbeitsmappe von den Macros ausschließen

[Kurtus]

Hallo liebe Experten,

ich habe folgendes Macro für meine Arbeitsmappe eingerichtet:

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
Dim i As Long
Dim celVal As String
 
For i = 1 To Target.Cells.Count
If Not Intersect(Target.Cells(i), Range("D11: BM81", "D86: BM92")) Is Nothing Then
celVal = UCase(Target.Cells(i).Value)
With Target.Cells(i)
.Font.ColorIndex = 0
Select Case celVal
Case "U", "SU", "LK", "AZ", "DB"
.Interior.ColorIndex = 28
.Font.ColorIndex = 0
.Font.Bold = True
.Font.Size = 8
Case "GT", "HA", "BS", "RB"
.Interior.ColorIndex = 19
.Font.ColorIndex = 0
.Font.Bold = True
.Font.Size = 8
Case "KR", "EZ"
.Interior.ColorIndex = 38
.Font.ColorIndex = 0
.Font.Bold = True
.Font.Size = 8
Case "#"
.Interior.ColorIndex = 19
.Font.Bold = True
.Font.Size = 10
.Font.ColorIndex = 7
Case "SA", "L", "ET", "DIF"
.Interior.ColorIndex = 40
.Font.ColorIndex = 0
.Font.Bold = True
.Font.Size = 8
Case "T", "N", "O"
.Interior.ColorIndex = 36
.Font.ColorIndex = 0
.Font.Bold = True
.Font.Size = 8
Case "BF"
.Interior.ColorIndex = 18
.Font.ColorIndex = 27
.Font.Bold = True
.Font.Size = 8
Case "BA"
.Interior.ColorIndex = 26
.Font.ColorIndex = 27
.Font.Bold = True
.Font.Size = 8
Case "SE"
.Interior.ColorIndex = 4
.Font.ColorIndex = 0
.Font.Bold = True
.Font.Size = 8
Case "WF", "TP", "AO"
.Interior.ColorIndex = 34
.Font.ColorIndex = 0
.Font.Bold = True
.Font.Size = 8
Case "V", "VX", "VT"
.Interior.ColorIndex = 6
.Font.ColorIndex = 0
.Font.Bold = True
.Font.Size = 8
Case "VN"
.Interior.ColorIndex = 6
.Font.ColorIndex = 0
.Font.Bold = True
.Font.Size = 8
Case Else
.Interior.ColorIndex = xlNone
.Font.Size = 8
End Select
End With
End If
Next i
End Sub

Diese Makro soll aber auf dem letzten Sheet mit dem Namen "Erreichbarkeiten" nicht aktiv sein, da es dort beim Ausfüllen die Schriftgröße nicht auf 8 setzen soll. 
Gibt es eine Möglichkeit dieses Macro nur für die Sheets "Januar bis Dezember" nicht aber für das Sheet Erreichbarkeit zu aktivieren?

Vielen Dank für Eure Hilfe!

[Ego]

Hallo K...,

was glaubst du wohl wofür der Parameter "Sh" steht?

Klammere deinen code in eine IF-Verzweigung:

If Sh.Name <> "Erreichbarkeit " Then
   dein code
End If

[Kurtus]

Hallo Helmut,

vielen Dank für Deine schnelle Antwort. 
Ich muss mich entschuldigen, ich bin leider Profi und mein Wissen beruht auf "Fundsachen" im Internet und "Learning by Doing".

Ich habe

If Sh.Name <> "Erreichbarkeiten" Then
vor der Zeile die mit Dim celVal... beginnt
und das End If  vor End Sub eingefügt.

Hierdurch ändert sich leider nichts. Auf dem Tabellenblatt "Erreichbarkeit" wird die Schrift beim Befüllen der Zellen noch immer in die Größe "8" geändert.

Kannst Du mir sagen wo genau ich das einfügen muss damit es wirksam wird? 

Nochmals sorry für mein Unwissen-

Vielen lieben Dank

Kurt

[Kuwer]

Hallo Kurt,

wie sieht es aus, wenn Du 'en' weglässt?

If Sh.Name <> "Erreichbarkeiten" Then

Gruß Uwe

[Zwergel]

Moin,

vielleicht prüft der Fragesteller erstmal wie sein Sheet tatsächlich benannt ist und verwendet dann richtig im Code

Diese Makro soll aber auf dem letzten Sheet mit dem Namen "Erreichbarkeiten" nicht aktiv sein, da es dort beim Ausfüllen die Schriftgröße nicht auf 8 setzen soll. 

Gibt es eine Möglichkeit dieses Macro nur für die Sheets "Januar bis Dezember" nicht aber für das Sheet Erreichbarkeit zu aktivieren?

[Kurtus]

Hallo Uwe, hallo Zwergel,

ihr habt recht, dass ich in meiner Anfrage zwei verschiedene Namen für das Sheet benutzte.
Dies war ein Tippfehler :20: . 

Ich habe aber hat schon darauf geachtet, dass der richtige Sheet-Name im Makro eingetragen ist.
Das Sheet heißt "Erreichbarkeiten" (mit "en").

Trotzdem ist mein Problem nicht gelöst und ich muss nochmals fragen ob ich die von Helmut genannte Lösung richtig platziert habe.

Hier nochmal das Macro mit der Änderung:
Hierdurch wird zwar auf dem Sheet "Erreichbarkeiten" die Größe nicht mehr geändert aber auf allen anderen Sheets funktionieren die mit dem Marco vorgesehenen Formatierungen nicht mehr...

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
If Sh.Name <> "Erreichbarkeiten" Then
Dim celVal As String
For i = 1 To Target.Cells.Count
If Not Intersect(Target.Cells(i), Range("D11: BM81", "D86: BM92")) Is Nothing Then
celVal = UCase(Target.Cells(i).Value)
With Target.Cells(i)
.Font.ColorIndex = 0
Select Case celVal
Case "U", "SU", "LK", "AZ", "DB"
.Interior.ColorIndex = 28
.Font.ColorIndex = 0
.Font.Bold = True
.Font.Size = 8
Case "GT", "HA", "BS", "RB"
.Interior.ColorIndex = 19
.Font.ColorIndex = 0
.Font.Bold = True
.Font.Size = 8
Case "KR", "EZ"
.Interior.ColorIndex = 38
.Font.ColorIndex = 0
.Font.Bold = True
.Font.Size = 8
Case "#"
.Interior.ColorIndex = 19
.Font.Bold = True
.Font.Size = 10
.Font.ColorIndex = 7
Case "SA", "L", "ET", "DIF"
.Interior.ColorIndex = 40
.Font.ColorIndex = 0
.Font.Bold = True
.Font.Size = 8
Case "T", "N", "O"
.Interior.ColorIndex = 36
.Font.ColorIndex = 0
.Font.Bold = True
.Font.Size = 8
Case "BF"
.Interior.ColorIndex = 18
.Font.ColorIndex = 27
.Font.Bold = True
.Font.Size = 8
Case "BA"
.Interior.ColorIndex = 26
.Font.ColorIndex = 27
.Font.Bold = True
.Font.Size = 8
Case "SE"
.Interior.ColorIndex = 4
.Font.ColorIndex = 0
.Font.Bold = True
.Font.Size = 8
Case "WF", "TP", "AO"
.Interior.ColorIndex = 34
.Font.ColorIndex = 0
.Font.Bold = True
.Font.Size = 8
Case "V", "VX", "VT"
.Interior.ColorIndex = 6
.Font.ColorIndex = 0
.Font.Bold = True
.Font.Size = 8
Case "VN"
.Interior.ColorIndex = 6
.Font.ColorIndex = 0
.Font.Bold = True
.Font.Size = 8
Case Else
.Interior.ColorIndex = xlNone
.Font.Size = 8
End Select
End With
End If
Next i
End If
End Sub

Vielen Dank

Kurt


Kommando zurück!!!!!
Nach dem Beenden des Debuggers funktionieren die Makros auch wieder in den anderen Sheets.

Vielen Dank Euch allen für die rege Unterstützung!

Kurt