ist es möglich, eine bestimmte Anzahl von Tabellenblättern automatisch zu benennen?
In Tabelle 1 habe ich eine namentliche Auflistung, und je Zelle (Namen) sollen die folgenden Tabellenblätter mit diesem Namen benannt werden.
Danke,
alex
Sub NamenVergeben()
Const t = "zz" 'Tabelle in der die Namen stehen
Const ErsteZelle = "B4" 'Erste Zelle der Namensliste
Dim max As Integer, i As Integer, ix As Integer, z As Long, s As Integer
With Sheets(t)
i = .Index
max = Sheets.Count
z = .Range(ErsteZelle).Row
s = .Range(ErsteZelle).Column
For ix = i + 1 To max
Sheets(ix).Name = .Cells(z, s)
z = z + 1
Next ix
End With
End Sub
Dieser Code schreibt alle Blätter bis zum letzten mit den Namen aus der Liste voll.
Wenn die Liste zu bald endet, entsteht ein Laufzeitfehler.
Gruß Matthias
Const t = "Tabelle1" 'Tabelle in der die Namen stehen
Const ErsteZelle = "A1" 'Erste Zelle der Namensliste
was willst du denn anders haben?
Gruß Matthias
Private Sub Worksheet_Change(ByVal Target As Range)
Const b = "A1:A100" 'überwachter Bereich
Dim z As Range, rng As Range
Set rng = Intersect(Target, Range(b))
If Not rng Is Nothing Then
On Error Resume Next
For Each z In rng
Sheets(z.Row + 1).Name = z.Value
If Err.Number > 0 Then
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
MsgBox Err.Description, vbExclamation, "Fehler " & Err.Number
Exit For
End If
Next z
End If
End Sub
Gruß Matthias
Private Sub Worksheet_Change(ByVal Target As Range)
Const b = "A1:A100" 'überwachter Bereich
Dim z As Range, rng As Range, n As String
Set rng = Intersect(Target, Range(b))
If Not rng Is Nothing Then
On Error Resume Next
For Each z In rng
If z = "" Then
n = "Tabelle" & z.Row + 1
Else
n = z.Value
End If
Sheets(z.Row + 1).Name = n
If Err.Number > 0 Then
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
MsgBox Err.Description, vbExclamation, "Fehler " & Err.Number
Exit For
End If
Next z
End If
End Sub
Gruß Matthias