Sheetname aus Zellle übernehmen
24.06.2016 17:46:26
Lupo
vor ein paar Tagen hatte ich mich mit folgender Fragestellung gemeldet:
Ich möchte die Sheets einer Exceltablle nach dem Inhalt einer Zelle benennen.
Vor der Benennung wird die betreffene Zelle auf Inhalt überprüft und ggf. dazu aufgefordert die Zelle zu füllen.
Zwischen dem eigentlichen Füllen der Zelle möchte ich in der aktiven Arbeitsmappe noch abfragen ob der neue Name schon vorhanden ist. Es soll quasi der Zelleninhalt mit allen vorhanden Sheetnamen verglichen werden bevor der Name übernommen wird bzw. wenn schon vorhanden eine Msgbox mit einem entsprechenden Hinweis erschein.
Von Michael habe ich dann das unten stehende Makro erhalten:
Danke schon mal dafür.
Nun habe ich dazu eine ergänzende Frage:
Wie muss der Code lauten, so dass am Ende nicht eine Msgbox erscheint, sondern dass dass schon vorhandene Sheet angewählt wird?
Hat jemand eine Idee?
Schöne Grüße,
Lupo
Option Explicit
Sub BlattNamen()
Dim a$(), i&, iMax&, B7$, actI&
Const gehtNicht = ":\/?*[]"
Dim gNaus$, erg
B7 = Range("B7").Text
If ActiveSheet.Name = B7 Then
MsgBox "Blatt heißt schon so."
Exit Sub
End If
actI = ActiveSheet.Index
iMax = Sheets.Count
ReDim a(1 To iMax)
For i = 1 To iMax
If i actI Then
a(i) = UCase(Sheets(i).Name)
Else
a(i) = ""
End If
Next
If Len(B7) = 0 Then
MsgBox "Bitte noch den Namen der Notiz " & _
"eintragen", vbCritical
Exit Sub
End If
For i = 1 To Len(B7)
If InStr(gehtNicht, Mid(B7, i, 1)) > 0 Then _
gNaus = gNaus & Mid(B7, i, 1)
Next
If gNaus "" Then
MsgBox "falsche(s) Zeichen: " & gNaus & _
" gefunden."
Exit Sub
End If
erg = Application.Match(UCase(B7), a, 0)
If IsNumeric(erg) Then
MsgBox B7 & " ist bereits in Blatt Nr." & _
erg & " vorhanden."
Else: ActiveSheet.Name = B7
End If
End Sub