Sub Kundenblaetter_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("Tabelle3").Columns("A:K")
With Sheets("Tabelle1")
For zz = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
For ss = 2 To Sheets.Count
If Sheets(ss).Name = CStr(.Cells(zz, 2)) Then
MsgBox "Blatt '" & .Cells(zz, 2) & "' 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)
End If
Next zz
End With
Beschleuniger Calc
End Sub
Sub Beschleuniger(Optional StatCal As Long = xlCalculationAutomatic)
With Application
.Calculation = StatCal
.ScreenUpdating = (StatCal <> xlCalculationManual)
.EnableEvents = (StatCal <> xlCalculationManual)
End With
End Sub