tabellenblätter automatisch umbenennen

[max]

hallo

iich möchte in meiner exceldatei die tabellenblätter automatisch den
namem eines zellinhalts benennen. gibt es eine möglichkeit die
folgenden tabellenblätter umzubenennen.
meine mappe besteht aus 5 blättern, die blattnamen sind die
jahreszahlen in folge. bei ersten blatt wird die jahreszahl
eingegeben und die jahreszahl für die folgenden jahre wird dann
automatisch auf die folgenden blätter in zelle a1 durch formel
übertragen. jetzt soll die jahreszahl auch als blattname übernommen
werden. und wenn beim ersten blatt die jahreszahl sich ändert sollen
die namen auch entsprechend der neuen jahreszahl als blattname
übernommen werden.

alle versuche sind bei mir aber bis jetzt gescheitert. es
funktioniert immer nur auf dem ersten blatt dank deinere hilfe.
vieleicht weiß jemand eine möglichkeit für mein problem.

ich habe auf den tabellenblättern bisher folgenden code

1. tabellenblatt
Private Sub worksheet_change(ByVal Target As Excel.Range)

Const snamecell As String = "a1"
Const serror As String = "invalid worksheet name in cell "
Dim ssheetname As String

With Target
If Not Intersect(.Cells, Range(snamecell)) Is Nothing Then
ssheetname = Range(snamecell).Value
If Not ssheetname = "" Then
On Error Resume Next
Me.name = ssheetname
On Error GoTo 0
If Not ssheetname = Me.name Then _
ssheetname = "a"
Me.name = ssheetname
Worksheets(2).Activate

End If
End If
End With


2. Tabellenblatt

Sub Worksheet_Activate()
Range("c1").Select
Worksheet
Worksheets(3).Activate
End Sub
Private Sub Worksheet()

Range("A1:B1").Select
Range("a1").Activate

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const snamecell As String = "a1"
Const serror As String = "invalid worksheet name in cell "
Dim ssheetname As String

With Target
If Not Intersect(.Cells, Range(snamecell)) Is Nothing Then
ssheetname = Range(snamecell).Value
If Not ssheetname = "" Then
On Error Resume Next
Me.name = ssheetname
On Error GoTo 0
If Not ssheetname = Me.name Then _
Wssheetname = "b"
Me.name = ssheetname

End If
End If
End With

End Sub

die umbenennung auf den einzelnen blättern funktioniert aber nicht alle
nacheinander, probleme gibt es auch wenn ein tabellenblatt schon den gleichen
namen hat

vielen dank für deine hilfe

[Melanie Breden]

Hallo max,

Post by max
iich möchte in meiner exceldatei die tabellenblätter automatisch den
namem eines zellinhalts benennen. gibt es eine möglichkeit die
folgenden tabellenblätter umzubenennen.
meine mappe besteht aus 5 blättern, die blattnamen sind die
jahreszahlen in folge. bei ersten blatt wird die jahreszahl
eingegeben und die jahreszahl für die folgenden jahre wird dann
automatisch auf die folgenden blätter in zelle a1 durch formel
übertragen. jetzt soll die jahreszahl auch als blattname übernommen
werden. und wenn beim ersten blatt die jahreszahl sich ändert sollen
die namen auch entsprechend der neuen jahreszahl als blattname
übernommen werden.

versuche mal folgenden Code:

' Code im ersten Tabellenblatt
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngSheet As Long

If Target.Address(0, 0) <> "A1" Then Exit Sub
If Not IsNumeric(Target.Value) Or Target.Value = "" Then Exit Sub

For lngSheet = 1 To 5
ThisWorkbook.Worksheets(lngSheet).Name = Target.Value - 1 + lngSheet
Next lngSheet
End Sub

[a***@discussions.microsoft.com]

hallo melanie

danke für deine hilfe funktioniert einwandfrei
ich habe aber noch ein problem.
wie kann ich fehler abfangen wenn ein anderes blatt schon
den selben namen hat. bei den namen handelt es sich um
jahrezahlen aber bei verrschiebung um z.b. 2 jahre sind
bei 5 tabellenblätter die namen schon vorhandnen nur auf
anderen blättern.

vielleicht kannst du mir noch einmal helfen

danke

-----Originalnachricht-----
Hallo max,

iich möchte in meiner exceldatei die tabellenblätter

automatisch den

namem eines zellinhalts benennen. gibt es eine

möglichkeit die

folgenden tabellenblätter umzubenennen.
meine mappe besteht aus 5 blättern, die blattnamen

sind die

jahreszahlen in folge. bei ersten blatt wird die

jahreszahl

eingegeben und die jahreszahl für die folgenden jahre

wird dann

automatisch auf die folgenden blätter in zelle a1

durch formel

übertragen. jetzt soll die jahreszahl auch als

blattname übernommen

werden. und wenn beim ersten blatt die jahreszahl sich

ändert sollen

die namen auch entsprechend der neuen jahreszahl als

blattname

übernommen werden.

' Code im ersten Tabellenblatt
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngSheet As Long
If Target.Address(0, 0) <> "A1" Then Exit Sub
If Not IsNumeric(Target.Value) Or Target.Value = ""

Then Exit Sub

For lngSheet = 1 To 5
ThisWorkbook.Worksheets(lngSheet).Name =

Target.Value - 1 + lngSheet

Next lngSheet
End Sub
--
Mit freundlichen Grüssen
Melanie Breden
- Microsoft MVP für Excel -
http://excel.codebooks.de (Das Excel-VBA Codebook)
#Excel-Auftragsprogrammierung#
.

[Melanie Breden]

HalloMax,

Post by a***@discussions.microsoft.com
danke für deine hilfe funktioniert einwandfrei
ich habe aber noch ein problem.
wie kann ich fehler abfangen wenn ein anderes blatt schon
den selben namen hat. bei den namen handelt es sich um
jahrezahlen aber bei verrschiebung um z.b. 2 jahre sind
bei 5 tabellenblätter die namen schon vorhandnen nur auf
anderen blättern.

dann änder vorab die Blattnamen in der ersten Schleife:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngSheet As Long

If Target.Address(0, 0) <> "A1" Then Exit Sub
If Not IsNumeric(Target.Value) Or Target.Value = "" Then Exit Sub

Application.ScreenUpdating = False
For lngSheet = 1 To 5
ThisWorkbook.Worksheets(lngSheet).Name = "Dummy" & lngSheet
Next lngSheet

For lngSheet = 1 To 5
ThisWorkbook.Worksheets(lngSheet).Name = Target.Value - 1 + lngSheet
Next lngSheet
Application.ScreenUpdating = True
End Sub

[Herbert Taferner]

Hallo Max,

versuchs mal damit,

'-----------------------------
Sub Blatt_umbenennen()
Dim i As Long, j As String

j = Worksheets(1).Range("A1").Value

For i = 1 To Worksheets.Count
Sheets(i).Activate
If Sheets(i).Name <> j Then
Sheets(i).Name = j
End If
j = j + 1

Next i
Sheets(1).Activate
End Sub
'-----------------------------

mfg Herbert