Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngTreffer As Range
Set rngTreffer = [A28:A200]
If Not Intersect(Target, rngTreffer) Is Nothing Then
Call Makro5(Target)
End If
Set rngTreffer = Nothing
End Sub
UND
Sub Makro5(Rng As Range)
Dim Zelle As Range, Wsh As Excel.Worksheet, flag As Boolean
On Error GoTo errh
Set Zelle = Rng
For Each Wsh In ThisWorkbook.Sheets
If Wsh.Name = "Test ID" & Zelle.Formula Then
flag = True
Exit For
End If
Next Wsh
Application.ScreenUpdating = False
If Not flag = True Then
Sheets("Muster").Copy After:=Sheets(Sheets.Count)
Set Wsh = ThisWorkbook.Sheets("Muster (2)")
With Wsh
.Name = "Test ID" & Zelle.Formula
.Visible = xlSheetVisible
.Range("B2").Font.Bold = True
End With
Zelle.Copy
Wsh.Range("B2").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
Wsh.Activate
errh:
Application.ScreenUpdating = True
End Sub
Ich bin kein Excel-Experte daher würde ich mich über jeden Vorschlag freuen.
Danke und Grüße
Sammy