Blatt mehrfach kopieren und fortlaufend

[DIZA]

Thema Fehlerbehandlung:

• DIZA verwendet keine // OK war im ersten Schuß nicht berücksichtigt jetzt im folgenden... quick&dirty aber funktional und kurz ohne Abbruch = Zielführend 
• Chat GPT nutzt On Error Resume Next // hast du in deinem "Programm" auch verwendet
• Bing nutzt es ebenfalls, die schreiben wohl voneinander ab …   
Beide werten einen evtl. Fehler aus, brechen aber als Folge das Makro rigoros ab, warum auch immer.

Code:

Option Explicit
Sub Blcopies()
Dim Menge As Long, C As Long, nn As String

Menge = InputBox("Wieviele Blattkopien sollen erstellt werden ?")
Application.DisplayAlerts = False
For C = 1 To Menge
   nn = Format(C, "000")
      Sheets("TEMPLATE").Copy After:=Sheets(Sheets.Count)
      On Error GoTo istda
      ActiveSheet.Name = nn
      GoTo weiter
istda:
On Error GoTo -1
ActiveSheet.Delete
weiter:
Next C
Application.DisplayAlerts = True
End Sub

[EarlFred]

Abschließend mein Senf, bevor ich mich Ralfs Wunsch entsprechend ruhig verhalte :
- On Error Resume Next und 
- Application.Displayalerts = False
Sind mit Vorsicht zu verwenden, da sie
- sinnvolle Fehlerverfolgung verhindern
- Warnhinweise mit (ggf. nicht gewünschten) Standardantworten abwürgen - Gefahr von Datenverlust

Man sollte es also zielgerichtet verwenden:
- On Error Resume Next : Set sh = Worksheets("Test") : On Error Goto errHandler (oder wohin auch immer)
- Application.Displayalerts = False : Worksheets("Test").Delete : Application.Displayalerts = True

Durch die Schreibweise werden Grund und Abhängigkeit klar und keiner schiebt aus Versehen eine Codezeile dazwischen. 

Klar kann man einwenden: „Aber genau hier kann das eigentlich alles nicht passieren, ich habe alles im Griff.“ 
„Eigentlich“ ist eine der häufigsten Fehlerursachen.

[DIZA]

@EarlFred
Deinen Senf in den Code geschmiert   (macht auch oder erst Recht bei Quick & Dirty Sinn)

Code:

Option Explicit
Sub Blcopies()
Dim Menge As Long, C As Long, nn As String
Menge = InputBox("Wieviele Blattkopien sollen erstellt werden ?")
For C = 1 To Menge
   nn = Format(C, "000")
      Sheets("TEMPLATE").Copy After:=Sheets(Sheets.Count)
      On Error GoTo istda
      ActiveSheet.Name = nn
      GoTo weiter
istda:
On Error GoTo -1
Application.DisplayAlerts = False: ActiveSheet.Delete: Application.DisplayAlerts = True
weiter:
Next C
End Sub

[EarlFred]

Dann werfe ich Euch mal einen zum Zerfleddern hin:

Code:

Option Explicit

Sub Test()
Dim i       As Long
Dim sName   As String
Dim shTest  As Object

For i = 1 To 10
   sName = Format(i, "000")
   Set shTest = Nothing
   On Error Resume Next: Set shTest = Sheets(sName): On Error GoTo 0
   If shTest Is Nothing Then
      ThisWorkbook.Worksheets("Template").Copy After:=ThisWorkbook.Sheets(i)
      ActiveSheet.Name = sName
   End If
Next i
End Sub

Wenn "Template" das einzige und erste Blatt neben den durchnummerierten ist, wird sortiert eingefügt.

[HKindler]

Hi,

@RPP63 dein SheetMissing könnte aber noch kürzer ausfallen:

Code:

Function SheetMissing(ShName$) As Boolean
SheetMissing = True
On Error Resume Next
SheetMissing = Sheets(ShName) Is Nothing
End Function

Wobei ich das lieber umgekehrt verwende, nämlich als SheetExists. Das fällt noch einfacher aus...

Code:

Function SheetExists(ShName$) As Boolean
On Error Resume Next
SheetExists = Not Sheets(ShName) Is Nothing
End Function

EDIT: zu spät gesehen, das es noch eine zweite Seite gibt...
Trotzdem hier meine 3- bzw. 2-Zeiler mit On Error Resume Next. Ich denke bei nur einer echten Code-Zeile ist dies erlaubt...

[derHoepp]

Moin,

eine wirklich gute KI hätte hoffentlich als erstes darauf hingewiesen, dass das Kopieren von Vorlagenblättern in 98% der Fälle auf ein schlechtes Datenmodell hinweist und die beste Lösung darin besteht, erst gar nix zu kopieren ?

Ansonsten muss ich schon zugeben, dass der Code nicht viel schlechter aussieht, als er auch von einem Helferlein oder Bastler mit VBA Grundkenntnissen zu erwarten wäre.

Viele Grüße
derHöpp