Sub EM_kopieren()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Calculation = xlCalculationManual
EnableEvents = False
Dim QWB As Workbook, ZWB As Workbook
Dim QWS As Worksheet, ZWS As Worksheet, ws As Worksheet
Dim Pfad As String, Register As String
Dim zähler As Integer, anzahl As Integer
Dim dname As Name
anzahl = ActiveWorkbook.Worksheets("Start").Range("G33").Value
Pfad = ActiveWorkbook.Worksheets("Start").Range("G8").Value
Set ZWB = ThisWorkbook
For Each dname In ZWB.Names
dname.Delete
Next dname
Workbooks.Open Filename:=Pfad
Set QWB = Workbooks("Module_Master.xlsm")
On Error Resume Next
For zähler = 11 To anzahl + 10
Register = ZWB.Worksheets("Start").Range("G" & zähler).Value
Set QWS = QWB.Worksheets(Register)
Set ZWS = ZWB.Worksheets("Example")
Set DWS = ZWB.Worksheets(Register)
DWS.Delete
QWS.Copy after:=ZWS
Next zähler
On Error GoTo 0
Workbooks("Module_master.xlsm").Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Calculation = xlCalculationAutomatic
EnableEvents = True
End Sub