Makro für gesamte Mappe statt für einzelnes Tabellenblatt

Question

Hallo,
ich habe ohne Programmierkenntnisse mir ein Makro zusammengebastelt (aus dem Internet ). Dieses gilt aber nur für ein Sheet. Gibt es eine Möglichkeit das Makro so zu ändern, dass es für alle Sheets der Arbeitsmappe funktioniert. Es sollen für einen bestimmten Bereich in allen Sheets beim Anklicken der Zelle ein "X" in die Zelle geschrieben werden.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("E5:U228")) Is Nothing Then
Select Case Target.Value
Case ""
Target.Value = "X"
Case Else
Target.Value = ""
End Select
End If
End Sub
Freundliche Grüße
Tom

Answer 1

Hallo Tom,

schreibe folgenden Code in den Codebereich "DieseArbeitsmappe"

Option Explicit

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("E5:U228")) Is Nothing Then
Select Case Target.Value
Case ""
Target.Value = "X"
Case Else
Target.Value = ""
End Select
End If
End Sub

Gruß
Rainer

Answer 2

Hallo Rainer,
vielen Dank für die Hilfe. Funktioniert auf Anhieb. Ich wünsche Dir noch einen schönen Tag.
Freundliche Grüße
Tom

Answer 3

Hallo,
war wohl doch etwas zu voreilig. Grunsätzlich ist die Antwort zwar richtig, aber mein Problem ist damit nicht gelöst, da in dieser Datei ein zweites Makro existiert, welches aus der Tabelle 1 zur Aktualisierung der anderen Tabellen Werte in die anderen Tabellen kopiert ( aber nicht in die Zellen, in die ich mit Klick ein "x" eintrage ). Sobald ich dieses Aktualisieren- Makro anstoße kommt die Fehlermeldung " Methode Intersect für das Objekt Global ist fehlgeschlagen". Offensichtlich "vertragen" sich die beiden Makros nicht. Gibt es noch eine andere Möglichkeit das Makro zu programmieren ( ohne Intersect )?
Freundliche Grüße
Tom

Answer 4

Hallo Tom,

zunächst wäre erst mal interessant zu wissen, wie der Code vom zweiten Makro aussieht.

Gruß
Rainer

Answer 5

Hallo Rainer,
der Code sieht so aus:
[code]Sub kopieren()
Dim i As Integer, Blatt As String
Application.ScreenUpdating = False
Sheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", _
"16", "17", "18", "19", "20", "21", "22")).Select
Sheets("1").Activate
Columns("A:Q").Select
Selection.ClearContents
Sheets("Anmeldung").Select
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
On Error Resume Next
Blatt = Sheets("Anmeldung").Cells(i, 14)
Worksheets("Anmeldung").Range("A" & i & ":R" & i).Copy
Sheets(Blatt).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Next
End Sub[b]
Freundliche Grüße
Tom

Answer 6

hi all ^^

es sind einige fehler in dem makro :-)

sollte rainer es noch nicht korrigiert haben bzw andere user nicht motiviert sein sollten,dann schick mir eine mustertabelle zu ,mit eindeutigen betreff und was das makro bewirken soll

oberley@t-online.de

gruss nighty

Answer 7

Hallo Tom,

nimm nighty's Angebot an, denn ich müsste auch erst Dein Makro analysieren um eine Testtabelle zu bauen zu können, dazu fehlen mir aber Lust und Zeit.

Gruß
Rainer

Answer 8

hi all ^^

sollte ein circelbezug nicht vermeidbar sein ,haben wir immer noch die moeglichkeit der ereignis ab/an schaltung

das nur so nebenbei als info

gruss nighty

Answer 9

Hallo,
ja, die Beispieltabelle ist verschickt. Schönes Wochenende noch an alle.
Gruß Thomas