Tabellenblätter umbenennen mit VBA

Private Sub Worksheet_Change(ByVal Target As Range) Const b = "A1:A118" 'ü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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Worksheet_Activate() Const b = "A1:A118" 'überwachter Bereich Dim z As Range, n As String On Error Resume Next For Each z In Range(b) 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 If Sheets.Count

Public Sub Mappe_XYZ(ByVal Rz As Long) Dim W As Worksheet, SN As String Set W = ActiveWorkbook.Worksheets(Rz + 1) If ActiveCell.Value 0 Then W.Name = ActiveCell.Value Else W.Name = "Tabelle" & CStr(Rz) End If W.Activate Set W = Nothing End Sub

hi Armin,
die Formel lautet wenn 0 dann leer, ich krieg keine 0.
soll ich das ändern?
Mist, habs grad ausprobiert, der klatscht mir neue Tabellenblätter hinter meine letzte Tabelle119.
Was is das denn?!
Schick dir nochmal mein Ding:
in Tabelle1 (Tabelle1) stehen die Makros:


Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
Cancel = True
If Target.Column = 1 And Target.Row

Sub Worksheet_Activate()
Const b = "A1:A118" 'überwachter Bereich
Dim z As Range, n As String
On Error Resume Next
For Each z In Range(b)
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
If Sheets.Count Sheets.Add After:=Sheets(Sheets.Count)
Sheets(z.Row + 1).Name = n
End If
End If
Next z
End Sub

'das nur die beschrifteten Tabellenblätter gedruckt werden:
Sub ausdruckleb()
For Each wks In Worksheets
If Not wks.Name Like "Tabelle*" Then wks.PrintOut 1, 2
Next wks
End Sub

in "Diese Arbeitsmappe":
leer
in Module
Modul1:


Public Sub Mappe_XYZ(ByVal Rz As Long)
Dim W As Worksheet, SN As String
Set W = ActiveWorkbook.Worksheets(Rz + 1)
If ActiveCell.Value  0 Then
W.Name = ActiveCell.Value
Else
W.Name = "Tabelle" & CStr(Rz)
End If
W.Activate
Set W = Nothing
End Sub

will dich nich nerven aber kannst du noch mal gucken?
grüsse
alex

Hi Alex, ja das geht schon aber das löst das Problem nicht! Wenn Du wieder sortierst ist die Zuorndung wieder putsch.
In jeder Mappe haben die Sheets eine laufende Nummer und einen Namen eines muss reverenzieren. Bei Dir die Nummer da Du den Namen änderst. Wenn Du jedoch die Sortierung ausführst änderst Du die Reihenfolge also die Nummer. Beides geht nicht entweder das eine oder das andere. Ich hätte das sowie "Abstrakter" gemacht. Dadurch das Du die Seite über einen Mausclick aktivierst ist es ja eigentlich garnicht nötig die Sheets umzubenennen. Dann schreibt man einfach in die Spalte B die Reverenz (B1,B2,B3...... so heißen zum Beispiel die Tabellen) und die dazugehörige Seite wird aktiviert (Natürlich muss der Code dann noch gerinfügig geändert werden - siehe weiter unten).
Mit den "stillgelegetem" Makro kannst Du auch 118 "neue Sheet" erzeugen (umbenennen und auf Sub Namen z.Bsp. Sub Alles_Neu () den Cursor und F5-Taste; Die Namenstabelle sollte aktiv sein!).


Public Sub Tab_Aufrufen_oder_Anlegen(ByVal Rz As Long)
Dim W As Worksheet, SN As String
If ActiveCell.Value  "" Then
If ActiveCell.Offset(0, 1).Value = "" Then
If Sheets.Count

Damit könnte man die von mir vorgeschlagene Variante realisieren.
Übrigens noch eleganter wäre ein Button und eine Auswahlliste die dann zu den entsprechen Sheet verzweigt. Aber das wir dann für das Forum zu komplex.
Gruß Armin

Beliebteste Forumthreads (12 Monate)

Tabellenblätter umbenennen mit VBA

19 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread