ich habe aus einem anderen Forum einen code der für mich ganz gut passt.
was ich gerne verändern würde ist, dass wenn der sheet name bereits vorhanden ist, der Zellwert um "_1" ..."_2" usw. für den Blattnamen hinzugefügt wird.
also anstatt dem Hinweis Blatt bereits vorhanden.
Kann mir da jemand helfen?
Danke
Option Explicit
Sub Bautagesberichte_anlegen()
Dim rngMuster As Range, calcOld As XlCalculation, zz As Long, ss As Long
Dim Calc As XlCalculation
Calc = Application.Calculation: Beschleuniger xlCalculationManual
Set rngMuster = Sheets("Kopierblatt").Columns("A:q")
With Sheets("Personalkalender")
For zz = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
For ss = 1 To Sheets.Count
If Sheets(ss).Name = CStr(.Cells(zz, 1)) Then
MsgBox "Blatt '" & .Cells(zz, 1) & "' bereits vorhanden.", vbInformation
Exit For
End If
Next ss
If ss > Sheets.Count Then
Worksheets.Add after:=Sheets(Sheets.Count)
rngMuster.Copy Cells(1, 1)
Cells(2, 1) = .Cells(zz, 1)
ActiveSheet.Name = CStr(Cells(2, 1))
End If
Next zz
End With
Beschleuniger Calc
End Sub
' Beschleuniger _______ Parameter: Calc-Status ______ gi/12.03.2006
' Aufruf:
' Dim Calc As XlCalculation
' Calc = Application.Calculation: Beschleuniger xlCalculationManual
' ....Code....
' Beschleuniger Calc
Sub Beschleuniger(Optional StatCal As Long = xlCalculationAutomatic)
With Application
.Calculation = StatCal
.ScreenUpdating = (StatCal xlCalculationManual)
.EnableEvents = (StatCal xlCalculationManual)
End With
End Sub