Tabellenblätter umbenennen gelöst

[totsch]

Wer kann evtl. helfen bzw. Auskunft geben?

Excel 2007 mit 26 Tabellenblätter mit den Bezeichnungen
A-15
B-15 usw.
bis Z-15

Kann man per VBA alle Tab.-Blätter auf einmal per "Suchen (15) - Ersetzen (16)" oder in einer anderen Form umbenennen, so dass sich danach ergibt:
A-16
B-16 usw.
bis Z-16

26 mal manuell umbenennen ist mir zu zeitaufwendig, zumal diese Umbenennung noch in weiteren Dateien vorgenommen werden müssen.

 

[patchmatch]

Hallo,

ich habe nur Excel 2016, bei mir funktioniert folgendes:

Sub Makro1()
Dim Suchposition As Integer
Dim NeuerName As String
For Each myWorksheet In Worksheets
Suchposition = InStr(myWorksheet.Name, "15")
Suchposition = Suchposition - 1
NeuerName = Left(myWorksheet.Name, Suchposition) & "16"
myWorksheet.Name = NeuerName
Next
End Sub

Vielleicht hilft Dir das weiter.

MfG

patchmatch

 

[totsch]

trotz eines Laufzeitfehlers klappt die Umbenennung mit "Suchen - Ersetzen" aller Tab.-Blätter schon mal. Danke! Liegt evtl. auch an den unterschiedlichen Excel-Versionen?!

Da es funktioniert hat, ist mir die Fehlermeldung dann auch eigentlich völlig egal.

Aber evtl. findest du trotzdem noch die entsprechende Korrektur?

 

[patchmatch]

Hallo totsch,

die Suchposition wird -1 wenn das Tabellenblatt keine 15 im Namen enthält. Left läuft dann auf den Fehler. Das kann man abfangen:

Sub Makro1()
Dim Suchposition As Integer
Dim NeuerName As String
For Each myWorksheet In Worksheets
Suchposition = InStr(myWorksheet.Name, "15")
Suchposition = Suchposition - 1
If Suchposition > -1 Then
NeuerName = Left(myWorksheet.Name, Suchposition) & "16"
myWorksheet.Name = NeuerName
End If
Next
End Sub

MfG

patchmatch

 

[totsch]

na super jetzt läuft es hervorragend! Ich danke dir.

 

[patchmatch]

Man muss nur beachten, dass bei dieser Programmierung die "15" am Ende der Bezeichnung stehen muss. Wenn Du eine 15 in der Mitte hast, dann wird der Rest rechts daneben abgeschnitten. Hier ist noch Potential, das Makro zu verbessern ...

MfG

patchmatch

 

[totsch]

Wenn Du eine 15 in der Mitte hast, dann wird der Rest rechts daneben abgeschnitten. Hier ist noch Potential, das Makro zu verbessern ...

nur für den Fall der Fälle, würde ich mir dieses Makro dann auch gerne in meine persönliche VBA-Sammlung aufnehemen wollen, z.B. für Tabellennamen in der Form >> "2015 - blablabla"
Könntest du das auch noch posten?

 

[patchmatch]

Hallo,

ich habe da mal etwas zum Ausprobieren:

Sub Arbeitsblaetter_umbenennen()
Dim Suchposition As Integer
Dim NeuerName As String
Dim Titel1, Wert1, Titel2, Wert2 As String
Dim Worsheetlaenge As Integer


'Eingabe der Werte
Titel1 = "Nach welchem Wert soll gesucht werden, um ihn später zu ersetzen?"
Titel2 = "Mit welchem Wert soll ersetzt werden?"
Wert1 = InputBox(Titel1)

If Wert1 = "" Then
MsgBox "Keinen Wert eingetragen"
Exit Sub
Else

Wert2 = InputBox(Titel2)

'Berechnung zu den Werten
Laenge = Len(Wert1)

'Umbenennen der Arbeitsblätter
For Each myWorksheet In Worksheets
Suchposition = InStr(myWorksheet.Name, Wert1)
Suchposition = Suchposition - 1
Worsheetlaenge = Len(myWorksheet.Name)

'Wenn der gesuchte Text am Anfang steht
If Suchposition = 0 Then
NeuerName = Wert2 & Mid(myWorksheet.Name, Laenge + 1)
myWorksheet.Name = NeuerName
End If

'Wenn der gesuchte Text in der Mitte steht
If Suchposition > 0 And Worsheetlaenge > (Suchposition + Laenge) Then
NeuerName = Left(myWorksheet.Name, Suchposition) & Wert2 & Right(myWorksheet.Name, Worsheetlaenge - (Suchposition + Laenge))
myWorksheet.Name = NeuerName
End If

'Wenn der gesuchte Text am Ende steht
If Suchposition > 0 And Worsheetlaenge = (Suchposition + Laenge) Then
NeuerName = Left(myWorksheet.Name, Suchposition) & Wert2
myWorksheet.Name = NeuerName
End If
Next
End If

End Sub

MfG

patchmatch

 

[totsch]

Makro ist bereits abgespeichert. Noch besser/eleganter ist aber das Makro, das du mir per Konv. geschickt hast. Beide funktionieren ausgezeichnet.
für deine Hilfe -

 

[Dancefree]

Hätte noch einen Vorschlag für Dich.

Der obig genannte Code ließe sich über die Nutzung von "Like" und "Replace" deutlich verkürzen.

Hier ein möglicher Vorschlag:

Sub Arbeitsblaetter_umbenennen()
Dim wSht As Worksheet
Dim ErrMsg, str1, str2 As String
ErrMsg = "Zeichenfolge fehlt"

' Eingabe der Werte
str1 = InputBox("Nach welcher Zeichenfolge soll gesucht werden, um sie später zu ersetzen?")
If str1 = "" Then MsgBox ErrMsg: Exit Sub

str2 = InputBox("Mit welcher Zeichenfolge soll ersetzt werden?")
If str2 = "" Then MsgBox ErrMsg: Exit Sub

' Umbenennen der Arbeitsblätter dieser Arbeitsmappe
For Each wSht In ThisWorkbook.Worksheets
If wSht.Name Like "*" & str1 & "*" Then
wSht.Name = Replace$(wSht.Name, str1, str2)
End If
Next
End Sub