CopyWorksheet.vba 1.3 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243
  1. Sub BlattKopieren()
  2. Dim NeuerName As String
  3. Dim i As Integer
  4. Do While NeuerName = ""
  5. NeuerName = InputBox("Please enter a new worksheet name!")
  6. Loop
  7. i = Sheets.Count
  8. Sheets("Vorlage").Copy After:=Sheets(i)
  9. ActiveSheet.Cells(6, 2) = NeuerName
  10. ActiveSheet.Name = CleanWorksheetName(NeuerName)
  11. End Sub
  12. Function CleanWorksheetName(ByRef strName As String) As String
  13. Dim varBadChars As Variant
  14. Dim varChar As Variant
  15. varBadChars = Array(":", "/", "\", "?", "*", "[", "]")
  16. 'correct string for forbidden characters
  17. For Each varChar In varBadChars
  18. Select Case varChar
  19. Case ":"
  20. strName = Replace(strName, varChar, vbNullString)
  21. Case "/"
  22. strName = Replace(strName, varChar, "-")
  23. Case "\"
  24. strName = Replace(strName, varChar, "-")
  25. Case "?"
  26. strName = Replace(strName, varChar, vbNullString)
  27. Case "*"
  28. strName = Replace(strName, varChar, vbNullString)
  29. Case "["
  30. strName = Replace(strName, varChar, "(")
  31. Case "]"
  32. strName = Replace(strName, varChar, ")")
  33. End Select
  34. Next varChar
  35. 'correct string for worksheet length requirement
  36. strName = Left(strName, 31)
  37. CleanWorksheetName = strName
  38. End Function