ursprünglicher Tabellenblattname

Sub Blattnamen () Dim Blatt As Object On Error Resume Next Sheets("Übersicht").Visible = False For Each Blatt In ActiveWorkbook.Worksheets If Blatt.Visible = True Then Blatt.Activate Blatt.Name = ActiveSheet.Cells(4, 5) 'zelle E4 (5.Spalte,4.Zeile) End If Next Blatt Sheets("Übersicht").Visible = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Blattnamen() Dim Blatt As Worksheet On Error Resume Next For Each Blatt In ActiveWorkbook.Worksheets If Blatt.Name <> "Übersicht" Then With Blatt If .Cells(4, 5) <> "" Then .Name = .Cells(4, 5) 'zelle E4 (5.Spalte,4.Zeile) Else .Name = .CodeName End If End With End If Next Blatt End Sub

Sub Blattnamen () Dim Blatt As Worksheet For Each Blatt In ActiveWorkbook.Worksheets If Blatt.Name""Übersicht then if Blatt.cells(4,5)="" then Blatt.Name = "Tabelle" & Blatt.Index Else Blatt.Name = Blatt.Cells(4,5).value End if End If Next Blatt End Sub

Hallo Alex,
und woher soll Excel wissen wie der Blattname vorher lautete?
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub RenameSheets()
    Dim objWS As Worksheet

    For Each objWS In ThisWorkbook.Worksheets
        If objWS.Visible = True Then
            If IsValidSheetName(objWS.Cells(4, 5).Text) And _
                Not SheetExist(objWS.Cells(4, 5).Text) Then
                objWS.Name = objWS.Cells(4, 5)
            Else
                If objWS.Name <> objWS.Cells(4, 5).Text Then
                    objWS.Name = objWS.CodeName
                End If
            End If
        End If
    Next

End Sub

Public Function IsValidSheetName(ByVal strName As String) As Boolean
    Dim objRegExp As Object

    Set objRegExp = CreateObject("vbscript.regexp")

    With objRegExp
        .Global = True
        .Pattern = "^[^\/\\:\*\?\[\]]{1,31}$"
        .IgnoreCase = True
        IsValidSheetName = .test(strName)
    End With

    Set objRegExp = Nothing

End Function

Private Function SheetExist(ByVal sheetName As String, Optional WbName As String) As Boolean
    Dim wks As Worksheet
    On Error GoTo ERRORHANDLER

    If WbName = "" Then WbName = ThisWorkbook.Name

    For Each wks In Workbooks(WbName).Worksheets
        If wks.Name = sheetName Then SheetExist = True: Exit Function
    Next

    ERRORHANDLER:
    SheetExist = False
End Function

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

ursprünglicher Tabellenblattname

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread