Es tut mir richtig leid euch so zu strapazieren. Aber ich habe mich da wohl etwas falsch ausgedrückt. Sorry. Ich fang mal mit Beverly an: Auch dir erst mal Dank für deine Mühen. Ich glaube aber, habe das schon richtig verstanden. Du hast aber die 30 Zellen am Stück in einem Bereich eingegrenzt. Ich "darf" aber nur 6 Zellen eingrenzen, weil dann erst mal eine Lücke kommen muß und dann die nächsten 6 Zellen kommen, die angesprochen werden sollen. Dazwichen darf nichts mit x liegen. So ereiche ich dann leider rasch die Grenze von 30 Möglichkeiten an EINGRENZUNGEN, die scheinbar unter Set Bereich = usw... möglich sind. Meine Hoffnung ist, daß ich irgendwie die Zuordnung von Set Bereichen noch nicht ganz richtig mache, denn wenn Ihr mal nachfolgenden Stand der Dinge anschaut, funktionieren alle Keuze bei DF und auch die Kreuze bei den Einzelansprachen (Set Bereich = Union(Bereich, [H546], [Q546], [Z546], [AI546], [AR546], [BA546], [BJ546], [BS546], [CB546], [CK546], [DF54 ..usw... aber alles unter H funktioniert nicht. Zur Vereinfachung habe ich in der Ansicht mal die funktionierenden Sachen Fett markiert. Jetzt wird zwar kein Debugger mit Fehlmeldung mehr geöffnet, es innitiiert sich aber auch kein Kreuz bei den Zellen unter Spalte H. Und auf diese Art hätte ich wie bei DF oder auch H noch weitere ST Bereiche mit gleichen Zellenzahlen unter 18 weiteren, (also ingesamt 20) Spalten anzusprechen (also Q,Z,AI,AR usw...), auf das da ein Kreuz bei Klick erscheint. Meine Hoffnung liegt also nicht in der Erklärung der zusammenfassenden 30 Zellenbereiche, sondern in der scheinbar falschen SetBereich Ansprache , so fern eben überhaupt mehrere SET Bereiche mit je 30 solcher Ansprachen wie zum Beispiel ("DF10:DF540") möglich sind.
So siehts momentan aus:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Bereich As Range
Set Bereich = Application.Union(Range("H10:H12"), Range("H18:H24"), Range("H30:H36"), Range(" _
H42:H49"), Range("H54:H60"), Range("H66:H72"), Range("H78:H84"), Range("H90:H96"), Range("H102:H108"), Range("H114:H120"), Range("H126:H132"), Range("H138:H144"), Range("H150:H156"), Range("H162:H168"), Range("H174:H180"), Range("H186:H192"), Range("H198:H204"), Range("H210:H216"), Range("H222:H228"), Range("H234:H240"), Range("H246:H252"), Range("H258:H264"), Range("H270:H276"), Range("H282:H288"), Range("H294:H300"), Range("H306:H312"), Range("H318:H324"), Range("H330:H336"), Range("H342:H348"), _
Range("H354:H360"))
Set Bereich = Union(Bereich, Range("H366:H372"), Range("H378:H384"), Range("H390:H396"), _
Range("H402:H408"), Range("H414:H420"), Range("H426:H432"), Range("H438:H444"), Range("H450:H456"), Range("H462:H468"), Range("H474:H480"), Range("H486:H492"), Range("H498:H504"), Range("H510:H516"), Range("H522:H528"), Range("H534:H540"))
Set Bereich = Application.Union(Range("DF10:DF12"), Range("DF18:DF24"), Range("DF30:DF36") _
, Range("DF42:DF49"), Range("DF54:DF60"), Range("DF66:DF72"), Range("DF78:DF84"), Range("DF90:DF96"), Range("DF102:DF108"), Range("DF114:DF120"), Range("DF126:DF132"), Range("DF138:DF144"), Range("DF150:DF156"), Range("DF162:DF168"), Range("DF174:DF180"), Range("DF186:DF192"), Range("DF198:DF204"), Range("DF210:DF216"), Range("DF222:DF228"), Range("DF234:DF240"), Range("DF246:DF252"), Range("DF258:DF264"), Range("DF270:DF276"), Range("DF282:DF288"), Range("DF294:DF300"), Range("DF306:DF312"), Range("DF318:DF324"), Range("DF330:DF336"), Range("DF342:DF348"), _
Range("DF354:DF360"))
Set Bereich = Union(Bereich, Range("DF366:DF372"), Range("DF378:DF384"), Range("DF390:DF396") _
, Range("DF402:DF408"), Range("DF414:DF420"), Range("DF426:DF432"), Range("DF438:DF444"), Range("DF450:DF456"), Range("DF462:DF468"), Range("DF474:DF480"), Range("DF486:DF492"), Range("DF498:DF504"), Range("DF510:DF516"), Range("DF522:DF528"), Range("DF534:DF540"))
Set Bereich = Union(Bereich, [H546], [Q546], [Z546], [AI546], [AR546], [BA546], [BJ546], [ _
BS546], [CB546], [CK546], [DF546], [DO546], [DX546], [EG546], [EP546], [EY546], [FH546], [FQ546], [FZ546], [GI546])
If Not Intersect(Target, Bereich) Is Nothing Then
If Target = "x" Then
Target = ""
Else
Target = "x"
End If
End If
Set Bereich = Nothing
End Sub