AW: Arbeitsblatt kopieren
03.02.2009 12:41:46
Nepumuk
Hallo,
da es beim umbenennen von Tabellen gewisse Restiktionen gibt, ist das ganze ein bisschen aufwendiger:
Public Sub Blatt_kopieren()
Dim vntReturn As Variant
Dim objRegEx As Object, objMatch As Object, objSheet As Object
Dim blnFound As Boolean
Set objRegEx = CreateObject("VBScript.RegExp")
With objRegEx
.Global = True
.Pattern = "[\\\/\:\*\?]"
End With
Do
Do
vntReturn = InputBox("Bitte den Namen für die Kopie eingeben.", "Eingabe")
If StrPtr(vntReturn) = 0 Then Exit Sub
If Len(Trim$(vntReturn)) > 0 Then
If Len(Trim$(vntReturn)) < 31 Then
Set objMatch = objRegEx.Execute(CStr(vntReturn))
If objMatch.Count = 0 Then
Exit Do
Else
MsgBox "Der Blattname darf keines dieser Zeichen enthalten: " & _
vbLf & vbLf & "\ / : * ?", vbExclamation, "Hinweis"
End If
Else
MsgBox "Der Blattname darf maximal 31 Zeichen lang sein.", vbExclamation, "Hinweis"
End If
Else
MsgBox "Der Blattname muss mindestens 1 Zeichen lang sein.", vbExclamation, "Hinweis"
End If
Loop
For Each objSheet In ThisWorkbook.Sheets
If objSheet.Name = vntReturn Then
blnFound = True
Exit For
End If
Next
If Not blnFound Then
Exit Do
Else
MsgBox "Der Blattname " & vntReturn & " ist schon vergeben." & _
vbLf & vbLf & "Bitte wählen sie einen anderen Namen", vbExclamation, "Hinweis"
End If
Loop
ActiveSheet.Copy Before:=Sheets(1)
ActiveSheet.Name = vntReturn
End Sub
Gruß
Nepumuk