hier, jung ...
22.01.2016 15:07:53
Matthias
Hallo
Option Explicit
Sub VorlageKopieren(wsBez As String)
Dim i As Integer, Check
Dim Weiter As Boolean
nochmal:
Application.ScreenUpdating = False
Weiter = False
wsBez = Replace(wsBez, ":", "")
wsBez = Replace(wsBez, "\", "")
wsBez = Replace(wsBez, "/", "")
wsBez = Replace(wsBez, "?", "")
wsBez = Replace(wsBez, "*", "")
wsBez = Replace(wsBez, "[", "")
wsBez = Replace(wsBez, "]", "")
With ThisWorkbook
For i = 1 To .Sheets.Count
'If LCase(.Worksheets(i).Name) = LCase(wsBez) Then
If .Worksheets(i).Name = wsBez Then
Check = MsgBox("Dieses Blatt existiert bereits!" & vbLf & "Soll es umbenannt _
werden?", vbYesNo)
On Error GoTo nochmal
'MsgBox Check 'hier Auswerten und entscheiden
If Check = 6 Then Worksheets(wsBez).Name = InputBox("Bitte jetzt umbenennen", , _
wsBez): Exit Sub
If Check = 7 Then Exit Sub 'Nein
End If
Next
Select Case Len(wsBez)
Case Is > 31
wsBez = Left(wsBez, 31)
Case Is = 0
If MsgBox("Zelle ist leer - Standardname für neues Blatt vergeben?", vbYesNo) = vbYes _
Then
Weiter = True
Else
Exit Sub
End If
Case Else
wsBez = wsBez
End Select
.Worksheets("Vorlage").Copy After:=Sheets(.Sheets.Count)
If Weiter Then
.ActiveSheet.Name = "Blatt " & .Sheets.Count + 1
Else: If Check 6 Then .ActiveSheet.Name = wsBez
End If
End With
Worksheets("Steuerung").Activate
Application.ScreenUpdating = True
End Sub
Gruß Matthias