Code 1
Sub AddSheets()
'Updateby Extendoffice
Dim xRg As Excel.Range
Dim wSh As Excel.Worksheet
Dim wBk As Excel.Workbook
Set wSh = ActiveSheet
Set wBk = ActiveWorkbook
Application.ScreenUpdating = False
For Each xRg In wSh.Range("A9:A90")
With wBk
.Sheets.Add After:=.Sheets(.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xRg.Value
If Err.Number = 1004 Then
Debug.Print xRg.Value & " already used as a sheet name"
End If
On Error GoTo 0
End With
Next xRg
Dim x As Integer
x = InputBox("Wie häufig möchten Sie die Arbeitsmappe kopieren?")
For numtimes = 1 To x
ActiveWorkbook.Sheets("Tabelle1").Copy _
After:=ActiveWorkbook.Sheets("Tabelle1")
Next
End Sub
Code 2
Sub Copier()
Dim x As Integer
x = InputBox("Wie häufig möchten Sie die Arbeitsmappe kopieren?")
For numtimes = 1 To x
ActiveWorkbook.Sheets("Tabelle1"). Copy _
After: =ActiveWorkbook.Sheets("Tabelle1")
Next
End Sub
Vielleicht gibt es bereits einen Code. Habe ihn leider nicht gefunden.Vielen Dank für eure Unterstützung.